1 |
dpavlin |
237 |
|
2 |
|
|
package provide mlcm::db 0.1 |
3 |
|
|
|
4 |
|
|
namespace eval mlcm::db { |
5 |
|
|
|
6 |
|
|
set _body { |
7 |
|
|
set len [llength $args] |
8 |
|
|
# puts "MMM $this CMD [lindex $args 0]" |
9 |
|
|
# puts "MMM $this REC $myrec" |
10 |
|
|
# puts "MMM $this REC [$myrec get -tags]" |
11 |
|
|
|
12 |
|
|
switch -glob -- [lindex $args 0] { |
13 |
|
|
all { |
14 |
|
|
set max [$myrec get maxrow] |
15 |
|
|
# puts "MMM $this all $max" |
16 |
|
|
$myrec set num $max |
17 |
|
|
$myrec set act 0 |
18 |
|
|
$myrec delete mfn |
19 |
|
|
for {set j 1} {$max >= $j} {incr j} { |
20 |
|
|
$myrec add mfn $j |
21 |
|
|
} |
22 |
|
|
return $max |
23 |
|
|
} |
24 |
|
|
hasNext { |
25 |
|
|
if {2 <= $len} { |
26 |
|
|
set incr [lindex $args 1] |
27 |
|
|
} { |
28 |
|
|
set incr 1 |
29 |
|
|
} |
30 |
|
|
set idx [$myrec get act] |
31 |
|
|
set max [$myrec get num] |
32 |
|
|
set nidx [expr $idx + $incr] |
33 |
|
|
# puts "MMM $this hasNext $len $incr $idx $max" |
34 |
|
|
return [expr 0 < $nidx && $nidx <= $max] |
35 |
|
|
} |
36 |
|
|
name { |
37 |
|
|
return [$myrec get name] |
38 |
|
|
} |
39 |
|
|
next { |
40 |
|
|
if {2 <= $len} { |
41 |
|
|
set incr [lindex $args 1] |
42 |
|
|
} { |
43 |
|
|
set incr 1 |
44 |
|
|
} |
45 |
|
|
set idx [$myrec get act] |
46 |
|
|
set max [$myrec get num] |
47 |
|
|
incr idx $incr |
48 |
|
|
if {$idx < 1} { |
49 |
|
|
set idx 1 |
50 |
|
|
} elseif {$idx > $max} { |
51 |
|
|
set idx $max |
52 |
|
|
} |
53 |
|
|
$myrec set act $idx |
54 |
|
|
# puts "MMM $this next -> $idx" |
55 |
|
|
return [$myrec get mfn\[[expr $idx - 1]\]] |
56 |
|
|
} |
57 |
|
|
rec { |
58 |
|
|
return $myrec |
59 |
|
|
} |
60 |
|
|
stub { |
61 |
|
|
return [$myrec get stub] |
62 |
|
|
} |
63 |
|
|
* { |
64 |
|
|
return [eval $myrec $args] |
65 |
|
|
} |
66 |
|
|
} |
67 |
|
|
} |
68 |
|
|
|
69 |
|
|
proc new {dbn stb} { |
70 |
|
|
variable _body |
71 |
|
|
set rec [openIsisRec -fdt $mlcm::meta::fdtDb] |
72 |
|
|
$rec set name $dbn stub $stb |
73 |
|
|
$rec set config [$stb db $dbn] |
74 |
|
|
if [catch { |
75 |
|
|
$stb .req delete |
76 |
|
|
$stb req type maxrow db $dbn |
77 |
|
|
set maxrow [$stb .res get row] |
78 |
|
|
# puts "MMM db $dbn maxrow $maxrow" |
79 |
|
|
$rec set maxrow $maxrow |
80 |
|
|
}] { |
81 |
|
|
global errorInfo |
82 |
|
|
puts $errorInfo |
83 |
|
|
} |
84 |
|
|
proc $dbn args " |
85 |
|
|
set myrec $rec |
86 |
|
|
set this $dbn |
87 |
|
|
$_body |
88 |
|
|
" |
89 |
|
|
return mlcm::db::$dbn |
90 |
|
|
} |
91 |
|
|
} |
92 |
|
|
|