1
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
2
;;; csv: reading files in Comma-Separated Values format.
3
;;; $Id: csv.lisp,v 1.12 2005/01/26 02:37:40 fare Exp $
7
http://www.cliki.net/fare-csv
10
http://www.geocities.com/SoHo/Cafe/5947/bugroff.html
13
apt-get install cl-asdf cl-parse-number
19
(read-csv-file "foo.csv")
25
I implemented just enough of csv to be able to import something
26
from a PC application that will remain unnamed.
27
If you need more, you can cont(r)act me, and/or hack it yourself.
30
Here's what the Perl crowd think about what CSV is:
31
http://www.perldoc.com/perl5.6.1/lib/Text/CSV.html
36
; -----------------------------------------------------------------------------
39
; If you have asdf and parse-number, load parse-number first.
40
(eval-when (:compile-toplevel :load-toplevel :execute)
41
;(pushnew :debug *features*)
42
(unless (ignore-errors
43
(fboundp (intern "PARSE-NUMBER" (find-package :parse-number))))
44
(pushnew :no-parse-number *features*)))
47
(eval-when (:compile-toplevel :load-toplevel :execute)
48
#-no-parse-number (asdf:oos 'asdf:load-op :parse-number)
50
(:use #-no-parse-number :parse-number :common-lisp)
51
(:export #:read-csv-line #:read-csv-stream))
52
(pushnew :fare-csv *features*))
54
(in-package :fare-csv)
56
; -----------------------------------------------------------------------------
58
(declaim (optimize (speed 3) (safety 1) (debug 3)))
60
; -----------------------------------------------------------------------------
61
;;; Thin compatibility layer
62
;;; FIXME: do we need to eval-when something?
64
(defun parse-number (s)
65
(let* ((*read-eval* nil)
66
(n (read-from-string s)))
69
; -----------------------------------------------------------------------------
70
;;; Choice of special characters
71
(defparameter *csv-separator* #\,
72
"Separator between CSV fields")
73
(defparameter *csv-quote* #\"
74
"delimiter of string data; pascal-like quoted as double itself in a string.")
76
; -----------------------------------------------------------------------------
79
(defmacro defsubst (name arglist &body body)
80
"Declare an inline defun."
81
`(progn (declaim (inline ,name))
82
(defun ,name ,arglist ,@body)))
84
(defsubst char-space-p (c)
85
"Is character C some kind of white space?
86
BUG: this only handles a tiny subset of character sets,
87
even if restricted to ASCII. However, it's rather portable."
88
(declare (type character c))
89
(member c '(#\Space #\Tab)))
90
(defsubst char-digit-or-dot-p (c)
91
"Is character C a digit or a dot?"
92
(declare (type character c))
93
(member c '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\.)))
94
(defsubst char-normal-p (c)
95
(declare (type character c))
96
(not (member c (list* *csv-separator* *csv-quote*
97
'(#\Space #\Return #\Linefeed)))))
98
(defsubst ns-accept-p (x s)
99
(let ((c (peek-char nil s nil nil)))
100
; #+DEBUG (format t "~%Current char: ~a" c)
102
(character (eql x c))
103
((or function symbol) (funcall x c))
104
(integer (eql x (char-code c))))))
105
(defsubst ns-accept (x s)
106
(and (ns-accept-p x s)
108
(defsubst ns-accept-eof (s)
109
(not (peek-char nil s nil nil)))
110
(defsubst ns-accept-eol (s)
111
(let ((x (ns-accept #\Return s)))
112
(or (ns-accept #\Linefeed s) x)))
113
(defsubst ns-accept-space (s)
114
(ns-accept #'char-space-p s))
115
(defsubst ns-accept-normal (s)
116
(ns-accept #'char-normal-p s))
117
(defsubst ns-accept-spaces (s)
118
(loop while (ns-accept-space s)))
119
(defsubst ns-accept-quote (s)
120
(ns-accept *csv-quote* s))
121
(defsubst ns-accept-separator (s)
122
(ns-accept *csv-separator* s))
124
(defun read-csv-line (s &aux (ss (make-string-output-stream)) (l '()))
127
;#+DEBUG (format t "~%Maybe field, l=~a" l)
129
(if (or (ns-accept-eol s) (ns-accept-eof s))
133
;#+DEBUG (format t "~%do field")
137
((ns-accept-separator s)
138
(progn (add nil) (maybe-field)))
139
((ns-accept-p #'char-digit-or-dot-p s)
143
;#+DEBUG (format t "~%string field")
145
((ns-accept *csv-quote* s)
146
(if (ns-accept *csv-quote* s)
147
(string-field-char *csv-quote*)
148
(progn (add (current-string))
151
(error "unexpected end of stream"))
153
(string-field-char (read-char s)))))
154
(string-field-char (c)
158
;#+DEBUG (format t "~%end of field")
161
((or (ns-accept-eol s) (ns-accept-eof s))
163
((ns-accept-separator s)
165
(t (error "end of field expected"))))
167
;#+DEBUG (format t "~%eat field")
168
(loop for c = (ns-accept-normal s) while c
169
do (add-char c) finally (return (current-string))))
171
;#+DEBUG (format t "~%numeric field")
172
(add (parse-number (eat-field)))
173
;#+DEBUG (format t "~%added number: ~a" (car l))
176
;#+DEBUG (format t "~%symbol field")
177
(add (intern (eat-field) :keyword))
178
;#+DEBUG (format t "~%added symbol: ~a" (car l))
185
(get-output-stream-string ss))
186
(done () (nreverse l)))
189
(defun read-csv-stream (s)
190
(loop until (ns-accept-eof s)
191
collect (read-csv-line s)))
193
(defun read-csv-file (pathname)
194
(with-open-file (s pathname :direction :input :if-does-not-exist :error)
195
(read-csv-stream s)))
197
;(trace read-csv-line read-csv-stream)
199
#+DEBUG (write (read-csv-file "test.csv"))
201
(setq *csv-separator* #\;)
202
(write (read-csv-file "/samba/ciev.csv")))
added
removed
csv-src.lisp
