including openisis 0.9.0 into webpac tree

[webpac] / openisis / tcl / lib / mlcm.db.tcl

diff --git a/openisis/tcl/lib/mlcm.db.tcl b/openisis/tcl/lib/mlcm.db.tcl
new file mode 100644 (file)
index 0000000..cec5cac
--- /dev/null
+++ b/openisis/tcl/lib/mlcm.db.tcl
@@ -0,0 +1,92 @@
+
+package provide mlcm::db 0.1
+
+namespace eval mlcm::db {
+
+       set _body {
+               set len [llength $args]
+               # puts "MMM $this CMD [lindex $args 0]"
+               # puts "MMM $this REC $myrec"
+               # puts "MMM $this REC [$myrec get -tags]"
+
+               switch -glob -- [lindex $args 0] {
+                       all {
+                               set max [$myrec get maxrow]
+                               # puts "MMM $this all $max"
+                               $myrec set num $max
+                               $myrec set act 0
+                               $myrec delete mfn
+                               for {set j 1} {$max >= $j} {incr j} {
+                                       $myrec add mfn $j
+                               }
+                               return $max
+                       }
+                       hasNext {
+                               if {2 <= $len} {
+                                       set incr [lindex $args 1]
+                               } {
+                                       set incr 1
+                               }
+                               set idx [$myrec get act]
+                               set max [$myrec get num]
+                               set nidx [expr $idx + $incr]
+                               # puts "MMM $this hasNext $len $incr $idx $max"
+                               return [expr 0 < $nidx && $nidx <= $max]
+                       }
+                       name {
+                               return [$myrec get name]
+                       }
+                       next {
+                               if {2 <= $len} {
+                                       set incr [lindex $args 1]
+                               } {
+                                       set incr 1
+                               }
+                               set idx [$myrec get act]
+                               set max [$myrec get num]
+                               incr idx $incr
+                               if {$idx < 1} {
+                                       set idx 1
+                               } elseif {$idx > $max} {
+                                       set idx $max
+                               }
+                               $myrec set act $idx
+                               # puts "MMM $this next -> $idx"
+                               return [$myrec get mfn\[[expr $idx - 1]\]]
+                       }
+                       rec {
+                               return $myrec
+                       }
+                       stub {
+                               return [$myrec get stub]
+                       }
+                       * {
+                               return [eval $myrec $args]
+                       }
+               }
+       }
+
+       proc new {dbn stb}  {
+               variable _body
+               set rec [openIsisRec -fdt $mlcm::meta::fdtDb]
+               $rec set name $dbn stub $stb
+               $rec set config [$stb db $dbn]
+               if [catch {
+                       $stb .req delete
+                       $stb req type maxrow db $dbn
+                       set maxrow [$stb .res get row]
+                       # puts "MMM db $dbn maxrow $maxrow"
+                       $rec set maxrow $maxrow
+               }] {
+                       global errorInfo
+                       puts $errorInfo
+               }
+               proc $dbn args "
+                       set myrec $rec
+                       set this $dbn
+                       $_body
+               "
+               return mlcm::db::$dbn
+       }
+}
+