]> wagner.pp.ru Git - sites/home_page.git/blob - software/tcl/csv2.tcl
grandpa picture
[sites/home_page.git] / 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