arnesi
(defun princ-csv (items csv-stream
&key (quote #\")
(separator #\,)[...]
(ignore-nulls t)
(newline +CR-LF+)
(princ #'princ-to-string))
"Write the list items to csv-stream."
(flet ((write-word (word)
(write-char quote csv-stream)
(loop
for char across (funcall princ word)
if (char= quote char) do
(progn
(write-char quote csv-stream)
(write-char quote csv-stream))
else do
(write-char char csv-stream))
(write-char quote csv-stream)))
(when items
(write-word (car items))
(dolist (i (cdr items))
(write-char separator csv-stream)
(if ignore-nulls
(when (not (null i))
(write-word i))
(write-word i)))
(write-sequence newline csv-stream))))
(defun princ-csv-to-string (items)
(with-output-to-string (csv)
(princ-csv items csv)))
(defun parse-csv-string (line &key (separator #\,) (quote #\"))
"Parse a csv line into a list of strings using @var{seperator}
as the column seperator and @var{quote} as the string quoting[...]
character."
(let ((items '())
(offset 0)
(current-word (make-array 20 :element-type 'character
:adjustable t
:fill-pointer 0))
(state :read-word))
(labels ((current-char ()
(aref line offset))
(current-char= (char)
(char= (current-char) char))
(chew-current-word ()
(push current-word items)
(setf current-word (make-array 20 :element-type 'character
:adjustable t
:fill-pointer 0))))
(loop
(when (= (length line) offset)
(ecase state
(:in-quotes
(error "Premature end of line."))
(:read-word
(chew-current-word)
(return-from parse-csv-string (nreverse items)))))
(ecase state
(:in-quotes
(if (current-char= quote)
(progn
(when (= (length line) (1+ offset))
(error "Premature end of line."))
(if (char= (aref line (1+ offset)) quote)
(progn
(vector-push-extend quote current-word)
(incf offset))
(setf state :read-word)))
(vector-push-extend (current-char) current-word)))
(:read-word
(if (current-char= quote)
(setf state :in-quotes)
(if (current-char= separator)
(chew-current-word)
(vector-push-extend (current-char) current-word)))))
(incf offset)))))