home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 5 / hacker05 / 05_HACK_05.ISO / programacao / freewrap / TCLLIBsampleApp.exe / sample / tcllib / tcllib1.0 / csv / csv.tcl next >
Encoding:
Text File  |  2001-08-17  |  7.1 KB  |  276 lines
  1. # csv.tcl --
  2. #
  3. #    Tcl implementations of CSV reader and writer
  4. #
  5. # Copyright (c) 2001 by Andreas Kupries <a.kupries@westend.com>
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. # 
  10. # RCS: @(#) $Id: csv.tcl,v 1.4 2001/08/02 16:38:06 andreas_kupries Exp $
  11.  
  12. package require Tcl 8.3
  13. package provide csv 0.1
  14.  
  15. namespace eval ::csv {
  16.     namespace export *
  17. }
  18.  
  19. # ::csv::join --
  20. #
  21. #    Takes a list of values and generates a string in CSV format.
  22. #
  23. # Arguments:
  24. #    values        A list of the values to join
  25. #    sepChar        The separator character, defaults to comma
  26. #
  27. # Results:
  28. #    A string containing the values in CSV format.
  29.  
  30. proc ::csv::join {values {sepChar ,}} {
  31.     set out ""
  32.     set sep {}
  33.     foreach val $values {
  34.     if {[string match "*\[\"$sepChar\]*" $val]} {
  35.         append out $sep\"[string map [list \" \"\"] $val]\" ; # "
  36.     } else {
  37.         append out $sep$val
  38.     }
  39.     set sep $sepChar
  40.     }
  41.     return $out
  42. }
  43.  
  44. # ::csv::joinlist --
  45. #
  46. #    Takes a list of lists of values and generates a string in CSV
  47. #    format. Each item in the list is made into a single CSV
  48. #    formatted record in the final string, the records being
  49. #    separated by newlines.
  50. #
  51. # Arguments:
  52. #    values        A list of the lists of the values to join
  53. #    sepChar        The separator character, defaults to comma
  54. #
  55. # Results:
  56. #    A string containing the values in CSV format, the records
  57. #    separated by newlines.
  58.  
  59. proc ::csv::joinlist {values {sepChar ,}} {
  60.     set out ""
  61.     foreach record $values {
  62.     append out "[join $record]\n"
  63.     }
  64.     return $out
  65. }
  66.  
  67. # ::csv::read2matrix --
  68. #
  69. #    A wrapper around "::csv::split2matrix" reading CSV formatted
  70. #    lines from the specified channel and adding it to the given
  71. #    matrix.
  72. #
  73. # Arguments:
  74. #    m        The matrix to add the read data too.
  75. #    chan        The channel to read from.
  76. #    sepChar        The separator character, defaults to comma
  77. #
  78. # Results:
  79. #    A list of the values in 'line'.
  80.  
  81. proc ::csv::read2matrix {chan m {sepChar ,}} {
  82.     while {![eof $chan]} {
  83.     if {[gets $chan line] < 0} {continue}
  84.     if {$line == {}} {continue}
  85.     split2matrix $m $line $sepChar
  86.     }
  87.     return
  88. }
  89.  
  90. # ::csv::read2queue --
  91. #
  92. #    A wrapper around "::csv::split2queue" reading CSV formatted
  93. #    lines from the specified channel and adding it to the given
  94. #    queue.
  95. #
  96. # Arguments:
  97. #    q        The queue to add the read data too.
  98. #    chan        The channel to read from.
  99. #    sepChar        The separator character, defaults to comma
  100. #
  101. # Results:
  102. #    A list of the values in 'line'.
  103.  
  104. proc ::csv::read2queue {chan q {sepChar ,}} {
  105.     while {![eof $chan]} {
  106.     if {[gets $chan line] < 0} {continue}
  107.     if {$line == {}} {continue}
  108.     split2queue $q $line $sepChar
  109.     }
  110.     return
  111. }
  112.  
  113. # ::csv::report --
  114. #
  115. #    A report command which can be used by the matrix methods
  116. #    "format-via" and "format2chan-via". For the latter this
  117. #    command delegates the work to "::csv::writematrix". "cmd" is
  118. #    expected to be either "printmatrix" or
  119. #    "printmatrix2channel". The channel argument, "chan", has to
  120. #    be present for the latter and must not be present for the first.
  121. #
  122. # Arguments:
  123. #    cmd        Either 'printmatrix' or 'printmatrix2channel'
  124. #    matrix        The matrix to format.
  125. #    args        0 (chan): The channel to write to
  126. #
  127. # Results:
  128. #    None for 'printmatrix2channel', else the CSV formatted string.
  129.  
  130. proc ::csv::report {cmd matrix args} {
  131.     switch -exact -- $cmd {
  132.     printmatrix {
  133.         if {[llength $args] > 0} {
  134.         return -code error "wrong # args: ::csv::report printmatrix matrix"
  135.         }
  136.         return [joinlist [$matrix get rect 0 0 end end]]
  137.     }
  138.     printmatrix2channel {
  139.         if {[llength $args] != 1} {
  140.         return -code error "wrong # args: ::csv::report printmatrix2channel matrix chan"
  141.         }
  142.         writematrix $matrix [lindex $args 0]
  143.         return ""
  144.     }
  145.     default {
  146.         return -code error "Unknown method $cmd"
  147.     }
  148.     }
  149. }
  150.  
  151. # ::csv::split --
  152. #
  153. #    Split a string according to the rules for CSV processing.
  154. #    This assumes that the string contains a single line of CSVs
  155. #
  156. # Arguments:
  157. #    line        The string to split
  158. #    sepChar        The separator character, defaults to comma
  159. #
  160. # Results:
  161. #    A list of the values in 'line'.
  162.  
  163. proc ::csv::split {line {sepChar ,}} {
  164.     regsub -all -- {(\A\"|\"\Z)} $line \0 line
  165.     set line [string map [list $sepChar\"\"\" $sepChar\0\" \
  166.         \"\"\"$sepChar \"\0$sepChar \
  167.         \"\" \" \" \0 ] $line]
  168.     set end 0
  169.     while {[regexp -indices -start $end -- {(\0)[^\0]*(\0)} $line -> start end]} {
  170.     set start [lindex $start 0]
  171.     set end   [lindex $end 0]
  172.     set range [string range $line $start $end]
  173.     set first [string first $sepChar $range]
  174.     if {$first >= 0} {
  175.         set line [string replace $line $start $end \
  176.             [string map [list $sepChar \1] $range]]
  177.     }
  178.     incr end
  179.     }
  180.     set line [string map [list $sepChar \0 \1 $sepChar \0 {} ] $line]
  181.     return [::split $line \0]
  182. }
  183.  
  184. # ::csv::split2matrix --
  185. #
  186. #    Split a string according to the rules for CSV processing.
  187. #    This assumes that the string contains a single line of CSVs.
  188. #    The resulting list of values is appended to the specified
  189. #    matrix, as a new row. The code assumes that the matrix provides
  190. #    the same interface as the queue provided by the 'struct'
  191. #    module of tcllib, "add row" in particular.
  192. #
  193. # Arguments:
  194. #    m        The matrix to write the resulting list to.
  195. #    line        The string to split
  196. #    sepChar        The separator character, defaults to comma
  197. #
  198. # Results:
  199. #    A list of the values in 'line', written to 'q'.
  200.  
  201. proc ::csv::split2matrix {m line {sepChar ,}} {
  202.     $m add row [split $line $sepChar]
  203.     return
  204. }
  205.  
  206. # ::csv::split2queue --
  207. #
  208. #    Split a string according to the rules for CSV processing.
  209. #    This assumes that the string contains a single line of CSVs.
  210. #    The resulting list of values is appended to the specified
  211. #    queue, as a single item. IOW each item in the queue represents
  212. #    a single CSV record. The code assumes that the queue provides
  213. #    the same interface as the queue provided by the 'struct'
  214. #    module of tcllib, "put" in particular.
  215. #
  216. # Arguments:
  217. #    q        The queue to write the resulting list to.
  218. #    line        The string to split
  219. #    sepChar        The separator character, defaults to comma
  220. #
  221. # Results:
  222. #    A list of the values in 'line', written to 'q'.
  223.  
  224. proc ::csv::split2queue {q line {sepChar ,}} {
  225.     $q put [split $line $sepChar]
  226.     return
  227. }
  228.  
  229. # ::csv::writematrix --
  230. #
  231. #    A wrapper around "::csv::join" taking the rows in a matrix and
  232. #    writing them as CSV formatted lines into the channel.
  233. #
  234. # Arguments:
  235. #    m        The matrix to take the data to write from.
  236. #    chan        The channel to write into.
  237. #    sepChar        The separator character, defaults to comma
  238. #
  239. # Results:
  240. #    None.
  241.  
  242. proc ::csv::writematrix {m chan {sepChar ,}} {
  243.     set n [$m rows]
  244.     for {set r 0} {$r < $n} {incr r} {
  245.     puts $chan [join [$m get row $r] $sepChar]
  246.     }
  247.  
  248.     # Memory intensive alternative:
  249.     # puts $chan [joinlist [m get rect 0 0 end end] $sepChar]
  250.     return
  251. }
  252.  
  253. # ::csv::writequeue --
  254. #
  255. #    A wrapper around "::csv::join" taking the rows in a queue and
  256. #    writing them as CSV formatted lines into the channel.
  257. #
  258. # Arguments:
  259. #    q        The queue to take the data to write from.
  260. #    chan        The channel to write into.
  261. #    sepChar        The separator character, defaults to comma
  262. #
  263. # Results:
  264. #    None.
  265.  
  266. proc ::csv::writequeue {q chan {sepChar ,}} {
  267.     while {[$q size] > 0} {
  268.     puts $chan [join [$q get] $sepChar]
  269.     }
  270.  
  271.     # Memory intensive alternative:
  272.     # puts $chan [joinlist [$q get [$q size]] $sepChar]
  273.     return
  274. }
  275.  
  276.