sics/tcl/table.tcl

#----------------------------------------------------------------------
# Support functions for table processing in SICS
#
# This includes a CSV processing module from someone else. See below.
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, November 2008
#----------------------------------------------------------------------
if { [info exists __tableheader] == 0 } {
    set __tableheader NULL
    Publish tableexe User
    Publish loop User
}
#=====================================================================
# Csv tcl package version 2.0
# A tcl library to deal with CSV (comma separated value) 
# files, generated and readable by some DOS/Windows programs
# Contain two functions:
#   csv2list string ?separator?
# and 
#   list2csv list ?separator?
# which converts line from CSV file to list and vice versa.
#
# Both functions have optional "separator argument" becouse some silly
# Windows
# program might use semicomon as delimiter in COMMA separated values
# file.
#
# Copyright (c) SoftWeyr, 1997-99
# Many thanks to Robert Seeger <rseeger1@nycap.rr.com>
#    for beta-testing and fixing my misprints
# This file is distributed under GNU Library Public License. Visit
#     http://www.gnu.org/copyleft/gpl.html
# for details.

#
# Convert line, read from CSV file into proper TCL list
# Commas inside quoted strings are not considered list delimiters,
# Double quotes inside quoted strings are converted to single quotes
# Double quotes are stripped out and replaced with correct Tcl quoting
#

proc csv2list {str {separator ","}} {
   #build a regexp>
   set regexp [subst -nocommands \
     {^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}]
   set regexp1 [subst -nocommands  {$regexp[ \t\r\n]*$separator\(.*)$}]
   set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}]
   set list {}
   while {[regexp $regexp1 $str junk1 unquoted quoted\
            junk2 str]} {
      if {[string length $quoted]||$unquoted=="\"\""} {
	  regsub -all {""} $quoted \" unquoted
      } 
      lappend list $unquoted
   }    
   if {[regexp $regexp2 $str junk unquoted quoted]} {
       if {[string length $quoted]||$unquoted=="\"\""} {
	       regsub -all {""} $quoted \" unquoted
       }
       lappend list $unquoted
       if {[uplevel info exist csvtail]} {
	   uplevel set csvtail {""}
       } 
   } else {
       if {[uplevel info exist csvtail]} {
         uplevel [list set csvtail $str]
       } else {
         return -code error -errorcode {CSV 1 "CSV parse error"}\
                 "CSV parse error: unparsed tail \"$str\""
       }
   }
   return $list
}   

proc list2csv {list {separator ","}} {
    set l {} 
    foreach elem $list {
    if {[string match {} $elem]||
        [regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\
		 $elem]} {
            lappend l $elem  
        } else {
            regsub -all {"} $elem {""} selem
            lappend l "\"$selem\"" 
        }
    }
    return [join $l $separator]
}

proc csvfile {f {separator ","}} {
     set csvtail ""
     set list {}
     set buffer {}
     while {[gets $f line]>=0} {
        if {[string length $csvtail]} {
	   set line "$csvtail\n$line"
	} elseif {![string length $line]} {
	   lappend list {}
	   continue
	}   
	set rec [csv2list $line $separator]
	set buffer [concat $buffer $rec]
	if {![ string length $csvtail]} {
	   lappend list $buffer 
	   set buffer {}
	}
     }	
     if {[string length $csvtail]} {
        return -code error -errorcode {CSV 2 "Multiline parse error"}\
	     "CSV file parse error"
     }
     return $list
}     
	
proc csvstring {str {separator ","}} {
     set csvtail ""
     set list {}
     set buffer {}
     foreach line [split $str "\n"] {
        if {[string length $csvtail]} {
	   set line "$csvtail\n$line"
	} elseif {![string length $line]} {
	   lappend list {}
	   continue
	}   
	set rec [csv2list $line $separator]
	set buffer [concat $buffer $rec]
	if {![ string length $csvtail]} {
	   lappend list $buffer 
	   set buffer {}
	}
     }	
     if {[string length $cvstail]} {
        return -code error -errorcode {CSV 2 "Multiline parse error"}\
	     "CSV string parse error"
     }
     return $list
}     

package provide Csv 2.1
#========================================================================
# The plan here is such: operations which happen fast or immediatly are 
# done at once. Count commands or anything given as command is appended 
# to a list for later execution. The idea is that this contains the 
# actual measuring payload of the row.
# Drivables are immediatly started.
# After processing the rows, there is a success to wait for motors to arrive
# Then the commands for later execution are run. This frees the user of the 
# the necessity to have the count or whatever command as the last thing in the row
#--------------------------------------------------------------------------------
proc testinterrupt {} {
    set int [getint]
    if {[string first continue $int] < 0} {
	error "Interrupted"
    }
} 
#--------------------------------------------------------------------------------
proc processtablerow {line} {
    global __tableheader
    set parlist [csv2list $line]
    for {set i 0} {$i < [llength $__tableheader]} {incr i} {
	set type [lindex $__tableheader $i]
	set data [lindex $parlist $i]
#--------- first process special types
	switch $type {
	    monitor {
		lappend laterExe "count monitor $data"
		continue
	    }
	    timer {
		lappend laterExe "count timer $data"
		continue
	    }
	    compar {
		append command [join [lrange $parlist $i end]]
		lappend laterExe $command
		break
	    }
	    command {
		lappend laterExe $data
		continue
	    }
	    batch {
		lappend laterExe "exe $data"
		continue
	    }
        }
#----------- now look for drivables
	set test [sicstype $type]
	if {[string compare $test DRIV] == 0} {
	    set status [catch {run $type $data} msg]
	    if {$status != 0} {
		clientput "ERROR: $msg for $type with $data"
	    }
	    continue
	}
#------------- now look for special objects
	set objtype [sicsdescriptor $type]
	switch $objtype {
	    SicsVariable -
	    MulMot -
	    Macro {
		set status [catch {eval $type $data} msg]
		if {$status != 0} {
		    clientput "ERROR: $msg for $type with $data"
		}
		continue
	    }
	    default {
		clientput "Skipping non recognized column $type with data $data"
	    }
	}
    }
    set status [catch {success} msg]
    if {$status != 0} {
	clientput "ERROR: $msg while waiting for motors to arrive"
    }
    testinterrupt
    foreach command $laterExe {
	eval $command
	testinterrupt
    }
}
#------------------------------------------------------------------------
proc tableexe {tablefile} {
    global __tableheader 
    if {[string first NULL $__tableheader] < 0} {
	error "Tableexe already running, terminated"
    }
    set fullfile [SplitReply [exe fullpath $tablefile]]
    set in [open $fullfile r]
    gets $in header
    set __tableheader  [csv2list $header]
    while {[gets $in line] > 0} {
	set status [catch {processtablerow $line} msg]
	if {$status != 0} {
	    set int [getint]
	    if {[string first continue $int] < 0} {
		break
            } else {
		clientput "ERROR: $msg while processing row"
	    }
	}
    }
    close $in
    set __tableheader NULL
    return "Done processing table"
}
#---------------------------------------------------------------------------
proc loop args {
      clientput $args
      if {[llength $args] < 2} {
	 error \
"Usage: loop  <no> <sicscommand>\n\t<no> number of repetions\n\t<sicscommand> any SICS command" 
      }
      set len [lindex $args 0]
      set command [lrange $args 1 end]
      for {set i 1} {$i <= $len} {incr i} {
	  clientput "Repetition $i of $len"
	  set status [catch {eval [join $command]} msg]
	  if {$status != 0} {
	      clientput "ERROR: $msg while processing loop command"
          }
	  testinterrupt
      }
}
#==============================================================================
# This is an old attempt
#=============================================================================
proc __tablescan__ args {
    global __tableheader

    set idx [lsearch $__tableheader monitor]
    if {$idx >= 0} {
	set preset [lindex $args $idx]
	set mode monitor
    }
    set idx [lsearch $__tableheader timer]
    if {$idx >= 0} {
	set preset [lindex $args $idx]
	set mode timer
    }

    set idx [lsearch $__tableheader scanvar]
    if {$idx >= 0} {
	set var [lindex $args $idx]
    } else {
	error "ERROR: No scan variable in table"
    }

    set idx [lsearch $__tableheader scanstart]
    if {$idx >= 0} {
	set start [lindex $args $idx]
    } else {
	error "ERROR: No scan start in table"
    }

    set idx [lsearch $__tableheader scanend]
    if {$idx >= 0} {
	set end [lindex $args $idx]
    } else {
	error "ERROR: No scan end in table"
    }

    set idx [lsearch $__tableheader scanstep]
    if {$idx >= 0} {
	set step [lindex $args $idx]
    } else {
	error "ERROR: No scan step in table"
    }

    set np [expr abs($end - $start)/$step]
    xxxscan var $var $start $step
    xxxscan run $np $mode $preset
}