/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (hide 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 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    

  ViewVC Help
Powered by ViewVC 1.1.26