Changeset 15 for trunk/readexp.tcl

Timestamp:

Dec 4, 2009 4:58:56 PM (14 years ago)

Author:

toby

Message:

# on 1999/01/01 18:30:08, toby did:
add existsexp, delexp, exphistory
change cdatget to use existsexp to avoid the debug warning

File:

• trunk/readexp.tcl (modified) (4 diffs, 3 props)

trunk/readexp.tcl

@@ -145 +145 @@
 }
 
+# return the number of records matching ISAM key (may contain wildcards)
+proc existsexp {key} {
+    global exparray
+    # key can contain wild cards so dont pad
+    return [llength [array names exparray  $key]]
+}
+
+
 # replace a section of the exparray with $value 
 #   replace $char characters starting at character $start (numbered from 1)
@@ -183 +191 @@
 }
 
+# delete an exp recorde
+# returns 1 if OK; 0 if not found
+proc delexp {key} {
+    global exparray
+    # truncate long keys & pad short ones
+    set key [string range "$key        " 0 11]
+    if [catch {unset exparray($key)}] {
+        return 0
+    }
+    return 1
+}
 # test an argument if it is a valid number; reform the number to fit
 proc validreal {val length decimal} {
@@ -212 +231 @@
 }
 
+# process history information
+#    action == last 
+#       returns number and value of last record
+#    action == add
+#
+proc exphistory {action "value 0"} {
+    global exparray
+    if {$action == "last"} {
+        set key [lindex [lsort -decreasing [array names exparray *HSTRY*]] 0]
+        if {$key == ""} {return ""}
+        return [list [string trim [string range $key 9 end]] $exparray($key)]
+    } elseif {$action == "add"} {
+        set key [lindex [lsort -decreasing [array names exparray *HSTRY*]] 0]
+        if {$key == ""} {
+            set key "    HSTRY  1"
+        } else {
+            set index [string trim [string range $key 9 end]]
+            if {$index != "***"} {
+                if {$index < 999} {incr index}
+                set key [format "    HSTRY%3d" $index]
+                set exparray($key) $value
+            }
+        }
+        set key [format "    HSTRY%3d" $index]
+        set exparray($key) $value
+    }
+}
 # get overall info 
 #   parm:
@@ -245 +291 @@
 proc cdatget {key} {
     foreach i {1 2 3 4 5 6 7 8 9} {
+        if {[existsexp "  GNLS CDAT$i"] == 0} break
         set line [readexp "  GNLS CDAT$i"]
         if {$line == {}} break