software/tcl/csv2.tcl

   1 # Csv tcl package version 2.0
   2 # A tcl library to deal with CSV (comma separated value)
   3 # files, generated and readable by some DOS/Windows programs
   4 # Contain two functions:
   5 #   csv2list string ?separator?
   6 # and
   7 #   list2csv list ?separator?
   8 # which converts line from CSV file to list and vice versa.
   9 #
  10 # Both functions have optional "separator argument" becouse some silly
  11 # Windows
  12 # program might use semicomon as delimiter in COMMA separated values
  13 # file.
  14 #
  15 # Copyright (c) SoftWeyr, 1997-99
  16 # Many thanks to Robert Seeger <rseeger1@nycap.rr.com>
  17 #    for beta-testing and fixing my misprints
  18 # This file is distributed under GNU Library Public License. Visit
  19 #     http://www.gnu.org/copyleft/gpl.html
  20 # for details.
  21
  22 #
  23 # Convert line, read from CSV file into proper TCL list
  24 # Commas inside quoted strings are not considered list delimiters,
  25 # Double quotes inside quoted strings are converted to single quotes
  26 # Double quotes are stripped out and replaced with correct Tcl quoting
  27 #
  28
  29 proc csv2list {str {separator ","}} {
  30    #build a regexp
  31    set regexp [subst -nocommands \
  32      {^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}]
  33    set regexp1 [subst -nocommands  {$regexp[ \t\r\n]*$separator\(.*)$}]
  34    set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}]
  35    set list {}
  36    while {[regexp $regexp1 $str junk1 unquoted quoted\
  37             junk2 str]} {
  38       if {[string length $quoted]||$unquoted=="\"\""} {
  39           regsub -all {""} $quoted \" unquoted
  40       }
  41       lappend list $unquoted
  42    }
  43    if {[regexp $regexp2 $str junk unquoted quoted]} {
  44        if {[string length $quoted]||$unquoted=="\"\""} {
  45                regsub -all {""} $quoted \" unquoted
  46        }
  47        lappend list $unquoted
  48        if {[uplevel info exist csvtail]} {
  49            uplevel set csvtail {""}
  50        }
  51    } else {
  52        if {[uplevel info exist csvtail]} {
  53          uplevel [list set csvtail $str]
  54        } else {
  55          return -code error -errorcode {CSV 1 "CSV parse error"}\
  56                  "CSV parse error: unparsed tail \"$str\""
  57        }
  58    }
  59    return $list
  60 }
  61
  62 proc list2csv {list {separator ","}} {
  63     set l {}
  64     foreach elem $list {
  65     if {[string match {} $elem]||
  66         [regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\
  67                  $elem]} {
  68             lappend l $elem
  69         } else {
  70             regsub -all {"} $elem {""} selem
  71             lappend l "\"$selem\""
  72         }
  73     }
  74     return [join $l $separator]
  75 }
  76
  77 proc csvfile {f {separator ","}} {
  78      set csvtail ""
  79      set list {}
  80      set buffer {}
  81      while {[gets $f line]>=0} {
  82         if {[string length $csvtail]} {
  83            set line "$csvtail\n$line"
  84         } elseif {![string length $line]} {
  85            lappend list {}
  86            continue
  87         }
  88         set rec [csv2list $line $separator]
  89         set buffer [concat $buffer $rec]
  90         if {![ string length $csvtail]} {
  91            lappend list $buffer
  92            set buffer {}
  93         }
  94      }
  95      if {[string length $csvtail]} {
  96         return -code error -errorcode {CSV 2 "Multiline parse error"}\
  97              "CSV file parse error"
  98      }
  99      return $list
 100 }
 101
 102 proc csvstring {str {separator ","}} {
 103      set csvtail ""
 104      set list {}
 105      set buffer {}
 106      foreach line [split $str "\n"] {
 107         if {[string length $csvtail]} {
 108            set line "$csvtail\n$line"
 109         } elseif {![string length $line]} {
 110            lappend list {}
 111            continue
 112         }
 113         set rec [csv2list $line $separator]
 114         set buffer [concat $buffer $rec]
 115         if {![ string length $csvtail]} {
 116            lappend list $buffer
 117            set buffer {}
 118         }
 119      }
 120      if {[string length $cvstail]} {
 121         return -code error -errorcode {CSV 2 "Multiline parse error"}\
 122              "CSV string parse error"
 123      }
 124      return $list
 125 }
 126
 127 package provide Csv 2.1