/[webpac]/openisis/current/tcl/lib/mlcm.db.tcl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/current/tcl/lib/mlcm.db.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years ago) by dpavlin
File MIME type: application/x-tcl
File size: 1779 byte(s)
initial import of openisis 0.9.0 vendor drop

1
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

  ViewVC Help
Powered by ViewVC 1.1.26