src/data/dsv-cybertiggyr.lisp

   1 ;;;
   2 ;;; $Header: /home/gene/library/website/docsrc/dsv/RCS/dsv.lisp,v 395.1 2008/04/20 17:25:46 gene Exp $
   3 ;;;
   4 ;;; Copyright (c) 2005 Gene Michael Stover.  All rights reserved.
   5 ;;;
   6 ;;; This program is free software; you can redistribute it and/or modify
   7 ;;; it under the terms of the GNU Lesser General Public License as
   8 ;;; published by the Free Software Foundation; either version 2 of the
   9 ;;; License, or (at your option) any later version.
  10 ;;;
  11 ;;; This program is distributed in the hope that it will be useful,
  12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU Lesser General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU Lesser General Public
  17 ;;; License along with this program; if not, write to the Free Software
  18 ;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301
  19 ;;; USA
  20 ;;;
  21
  22 (defpackage :cybertiggyr-dsv
  23   (:use :common-lisp)
  24   (:import-from :cybertiggyr-test "DEFTEST")
  25   (:export "*END-OF-RECORD*"
  26            "*ESCAPE*"
  27            "*FIELD-SEPARATOR*"
  28            "DO-ESCAPED"
  29            "LOAD-ESCAPED"
  30            "READ-ESCAPED"))
  31
  32 (in-package "CYBERTIGGYR-DSV")
  33
  34 ;;;
  35 ;;; UNEXPORTED HELPER FUNCTIONS & STOOF
  36 ;;;
  37
  38 (defun xpeek (strm)
  39   "Return the next character without consuming it, or return STRM on
  40 end-of-input or other error."
  41   (peek-char nil strm nil strm))
  42
  43 (defun consume-leading-crap (strm crap)
  44   "Read (consume) newlines until the next character is not a newline or
  45 there is no next character (end-of-input, which isn't an error)."
  46     (loop while (eql (xpeek strm) crap) do (read-char strm))
  47   'consume-leading-crap)
  48
  49 (defun read-escaped-field (strm terminators escape)
  50   "Return the next field as a string.  Return STRM if there is no next
  51 field, which is when the stream is already at its end.  Assumes caller
  52 has already consumed white-space crap that might preceed the field.
  53 Consumes the character which ends the field.  TERMINATORS is a list
  54 of characters & the stream which could terminate the field."
  55   (if (eq (xpeek strm) strm)
  56       strm                              ; already at end-of-input
  57     ;; else, Consume & collect characters until we find a terminator (field
  58     ;; terminator, record terminator, or end-of-input).  Do not collect
  59     ;; the terminator.
  60     (coerce
  61      (loop until (member (xpeek strm) terminators)
  62            collect (if (eql (xpeek strm) escape)
  63                        ;; It's an escape, so discard it & use the next
  64                        ;; character, verbatim.
  65                        (progn (read-char strm) (read-char strm))
  66                      ;; else, Use this character.
  67                      (read-char strm)))
  68      'string)))
  69
  70 ;;;
  71 ;;;
  72 ;;;
  73
  74 (defvar *field-separator* #\:
  75   "The default field separator character.  It defaults to colon (:).")
  76
  77 (defvar *end-of-record* #\Newline
  78   "The end-of-record character.  Defaults to Newline.")
  79
  80 (defvar *escape* #\\
  81   "The default escape character for unix-style DSV files.  It uses a single
  82 escape character to allow the field separator character to occur
  83 within fields.  The escape character can be used to allow an end-of-line
  84 character or an escape character to occur in fields, too.
  85 Defaults to backslash (\\).  You can change it with SETQ.  If you do not
  86 want to allow separator characters at all, bind it to NIL.")
  87
  88 (defun read-escaped (strm &key (field-separator *field-separator*)
  89                           (end-of-record *end-of-record*)
  90                           (escape *escape*))
  91   "Read (consume) & return the next DSV record from STRM.  The record
  92 will be a list of fields.  The fields will be strings.  Field separator
  93 & end-of-record characters may not occur within fields unless escaped.
  94 If you don't want to allow any kind of escape, use NIL for the escape
  95 character.  Since NIL is not a character, it will never be equal to a
  96 character read from STRM, so there will be no possible escape character.
  97 In fact, you could use any non-character to disable the escape
  98 character.  Ignors empty lines.  On end-of-input, returns STRM.  It is
  99 an error if an escape character is followed by end-of-input.
 100
 101 <example broken=TRUE>
 102   (with-open-stream (s (make-stream-from-file \"test.csv\"))
 103      (loop (read-escaped s) collecting result))
 104 </example>
 105 "
 106   (consume-leading-crap strm end-of-record)
 107   (if (eq (xpeek strm) strm)
 108       strm                              ; normal end-of-input
 109     ;; else, Let's collect fields until we have read an entire record.
 110     (prog1
 111         (loop until (member (xpeek strm) (list strm end-of-record))
 112               collect (prog1
 113                           (read-escaped-field strm
 114                                               (list strm field-separator
 115                                                     end-of-record)
 116                                               escape)
 117                         (when (eql (xpeek strm) field-separator)
 118                           ;; Consume the character which ended the field.
 119                           ;; Notice that we do not consume end-of-record
 120                           ;; characters.
 121                           (read-char strm))))
 122       (consume-leading-crap strm end-of-record))))
 123
 124 (defun load-escaped (pathname &key (field-separator *field-separator*)
 125                               (end-of-record *end-of-record*)
 126                               (escape *escape*)
 127                               (filter #'identity)
 128                               (trace nil))
 129   "Return the entire contents of an escaped DSV file as a list of
 130 records.  Each record is a list."
 131   (with-open-file (strm pathname :direction :input)
 132     (labels ((is-good (x) (funcall filter x))
 133              (xread () (read-escaped strm :field-separator field-separator
 134                                      :end-of-record end-of-record
 135                                      :escape escape)))
 136       (do ((lst () (if (is-good x) (cons x lst) lst))
 137            (x (xread) (xread))
 138            (i 0 (1+ i)))
 139           ((eq x strm) lst)
 140           (when (and trace (zerop (mod i 1000)))
 141             (format trace "~&~A: [~D] ~S" 'load-escaped i x))))))
 142
 143 ;;;
 144 ;;; todo: new new new.  Document me!!!
 145 ;;;
 146 (defmacro do-escaped ((var pathname) &body body)
 147   (let ((strm (gensym)))
 148     `(with-open-file (,strm ,pathname :element-type 'character
 149                             :direction :input :if-does-not-exist :error)
 150        (loop for ,var = (read-escaped ,strm)
 151              while (not (eq ,var ,strm))
 152              do (progn ,@body))
 153        (truename ,pathname))))
 154
 155 ;;;
 156 ;;; TESTS
 157 ;;;
 158
 159 (deftest test0000 ()
 160   "Null test.  Always succeeds."
 161   'test0000)
 162
 163 (deftest test0010 ()
 164   "Test that XPEEK returns the correct character from a stream, does
 165 not consume the character.  The character is NOT the last in the stream."
 166   (with-input-from-string (strm "abc")
 167     (and (eql (xpeek strm) #\a)
 168          (eql (read-char strm) #\a))))
 169
 170 (deftest test0011 ()
 171   "Like TEST0011 except that it tests XPEEK on the last character in the
 172 stream.  In other words, tests that XPEEK returns the correct value &
 173 does not consume it, & that character is the last in the stream."
 174   (with-input-from-string (strm "c")
 175     (and (eql (xpeek strm) #\c)
 176          (eql (read-char strm) #\c))))
 177
 178 (deftest test0012 ()
 179   "Test XPEEK on an empty stream."
 180   (with-input-from-string (strm "")
 181     (and (eq (xpeek strm) strm)
 182          (eq (read-char strm nil strm) strm))))
 183
 184 (deftest test0015 ()
 185   "Test CONSUME-LEADING-CRAP on a stream that contains nothing but leading
 186 crap."
 187   (with-input-from-string (strm (format nil "~%~%~%"))
 188     (and (eql (xpeek strm) #\Newline)   ; not at end
 189          (consume-leading-crap strm #\Newline) ; doesn't matter what it returns
 190          (eq (read-char strm nil strm) strm)))) ; now we're at end
 191
 192 (deftest test0016 ()
 193   "Test CONSUME-LEADING-CRAP on a streeam that starts with leading crap,
 194 then has some non-crap."
 195   (with-input-from-string (strm (format nil "~%~%~%a"))
 196     (and (eql (xpeek strm) #\Newline)   ; not at end
 197          (consume-leading-crap strm #\Newline) ; doesn't matter what it returns
 198          (eql (read-char strm) #\a))))
 199
 200 (deftest test0017 ()
 201   "Test CONSUME-LEADING-CRAP on a stream that starts with non-crap, then
 202 has some crap.  CONSUME-LEADING-CRAP should not consume the leading
 203 non-crap."
 204   (with-input-from-string (strm (format nil "a~%"))
 205     (and (eql (xpeek strm) #\a)         ; not at end
 206          (consume-leading-crap strm #\Newline) ; doesn't matter what it returns
 207          (eql (read-char strm) #\a))))  ; the "a" char should remain
 208
 209 (deftest test0020 ()
 210   "Test READ-ESCAPED-FIELD on a stream that contains a single field
 211 followed by end-of-input.  Uses the default field separator, end-of-record
 212 character, & escape character.  Just test that the field is read, not that
 213 the next READ-ESCAPED-FIELD indicates end-of-input."
 214   (with-input-from-string (strm "abc")
 215     (equal (read-escaped-field strm
 216                                (list strm *field-separator* *end-of-record*)
 217                                *escape*)
 218            "abc")))
 219
 220 (deftest test0021 ()
 221   "Like TEST0020, but also checks that another call to READ-ESCAPED-FIELD
 222 indicates end-of-input by returning STRM."
 223   (with-input-from-string (strm "abc")
 224     (let* ((a (read-escaped-field strm
 225                                   (list strm *field-separator* *end-of-record*)
 226                                   *escape*))
 227            (b (read-escaped-field strm
 228                                   (list strm *field-separator* *end-of-record*)
 229                                   *escape*)))
 230       (unless (equal a "abc")
 231         (format t "~&~A: First read should have returned" 'test0021)
 232         (format t " ~S, but it returned ~S" "abc" a))
 233       (unless (eq b strm)
 234         (format t "~&~A: Second read should have returned" 'test0021)
 235         (format t " ~S, but it returned ~S" strm b))
 236       (and (equal a "abc") (eq b strm)))))
 237
 238 (deftest test0025 ()
 239   "Test that READ-ESCAPED-FIELD works on two consecutive fields."
 240   (let ((a "abc") (b "xyz"))
 241     (with-input-from-string (strm (format nil "~A~A~A" a *field-separator* b))
 242       (let* ((terminators (list strm *field-separator* *end-of-record*))
 243              (xa (read-escaped-field strm terminators *escape*))
 244              (xseparator (read-char strm))
 245              (xb (read-escaped-field strm terminators *escape*))
 246              (xstrm (xpeek strm)))
 247         (and (equal xa a) (eql xseparator *field-separator*) (equal xb b)
 248              (eq xstrm strm))))))
 249
 250 (deftest test0026 ()
 251   "Test that READ-ESCAPED-FIELD works on two records of two fields each.
 252 The second record does not end with an end-of-record character.  It
 253 ends with end-of-input on the stream."
 254   (let* ((a "abc") (b "123")            ; first record
 255          (c "def") (d "456")            ; second record
 256          (string (format nil "~A~A~A~A~A~A~A" a *field-separator* b
 257                          *end-of-record* c *field-separator* d)))
 258     (with-input-from-string (strm string)
 259       (let* ((terminators (list strm *field-separator* *end-of-record*))
 260              (xa (read-escaped-field strm terminators *escape*))
 261              (xseparator0 (read-char strm))
 262              (xb (read-escaped-field strm terminators *escape*))
 263              (xend-of-record0 (read-char strm))
 264              (xc (read-escaped-field strm terminators *escape*))
 265              (xseparator1 (read-char strm))
 266              (xd (read-escaped-field strm terminators *escape*))
 267              (xstrm (xpeek strm)))
 268         (and (equal xa a)
 269              (eql xseparator0 *field-separator*)
 270              (equal xb b)
 271              (eql xend-of-record0 *end-of-record*)
 272              (equal xc c)
 273              (eql xseparator1 *field-separator*)
 274              (equal xd d)
 275              (eq xstrm strm))))))
 276
 277 (deftest test0027 ()
 278   "Like TEST0026 except that the second record ends with an end-of-
 279 record character."
 280   (let* ((a "abc") (b "123")            ; first record
 281          (c "def") (d "456")            ; second record
 282          (string (format nil "~A~A~A~A~A~A~A~A" a *field-separator* b
 283                          *end-of-record* c *field-separator* d
 284                          *end-of-record*)))
 285     (with-input-from-string (strm string)
 286       (let* ((terminators (list strm *field-separator* *end-of-record*))
 287              (xa (read-escaped-field strm terminators *escape*))
 288              (xseparator0 (read-char strm))
 289              (xb (read-escaped-field strm terminators *escape*))
 290              (xend-of-record0 (read-char strm))
 291              (xc (read-escaped-field strm terminators *escape*))
 292              (xseparator1 (read-char strm))
 293              (xd (read-escaped-field strm terminators *escape*))
 294              (xend-of-record1 (read-char strm))
 295              (xstrm (xpeek strm)))
 296         (and (equal xa a)
 297              (eql xseparator0 *field-separator*)
 298              (equal xb b)
 299              (eql xend-of-record0 *end-of-record*)
 300              (equal xc c)
 301              (eql xseparator1 *field-separator*)
 302              (equal xd d)
 303              (eql xend-of-record1 *end-of-record*)
 304              (eq xstrm strm))))))
 305
 306 (deftest test0050 ()
 307   "Test READ-ESCAPED on an input stream containing a single record of a
 308 single field."
 309   (let* ((record (list "abc"))
 310          (string (format nil "~A" (first record))))
 311     (with-input-from-string (strm string)
 312       (let* ((xrecord (read-escaped strm))
 313              (xstrm (xpeek strm)))
 314         (and (equal xrecord record)
 315              (eq xstrm strm))))))
 316
 317 (deftest test0051 ()
 318   "Test READ-ESCAPED on an input stream containing a single record of two
 319 fields."
 320   (let* ((record (list "abc" "123"))
 321          (string (format nil "~A~A~A" (first record) *field-separator*
 322                          (second record))))
 323     (with-input-from-string (strm string)
 324       (let* ((xrecord (read-escaped strm))
 325              (xstrm (xpeek strm)))
 326         (and (equal xrecord record)
 327              (eq xstrm strm))))))
 328
 329 (deftest test0052 ()
 330   "Test READ-ESCAPED.  After reading the single record of two fields,
 331 the stream should be at its end.  The record is followed by several
 332 end-of-record characters, & the stream should be at its end after
 333 reading the record because no records follow the record terminators."
 334   (let* ((record (list "abc" "123"))
 335          (string (format nil "~A~A~A~A~A~A" (first record) *field-separator*
 336                          (second record) *end-of-record* *end-of-record*
 337                          *end-of-record*)))
 338     (with-input-from-string (strm string)
 339       (let* ((xrecord (read-escaped strm))
 340              (xstrm (xpeek strm)))
 341         (and (equal xrecord record)
 342              (eq xstrm strm))))))
 343
 344 (deftest test0053 ()
 345   "Test READ-ESCAPED on an input of two, two-field records.  The second
 346 record is followed by one end-of-record character."
 347   (let ((record0 '("aaa" "111"))
 348         (record1 '("bbb" "222"))
 349         (string (format nil "aaa~A111~Abbb~A222~A"
 350                         *field-separator* *end-of-record*
 351                         *field-separator* *end-of-record*)))
 352     (with-input-from-string (strm string)
 353       (let* ((xrecord0 (read-escaped strm))
 354              (xrecord1 (read-escaped strm)))
 355         (unless (equal xrecord0 record0)
 356           (format t "~&First record is ~S.  Expected ~S." xrecord0 record0))
 357         (unless (equal xrecord1 record1)
 358           (format t "~&Second record is ~S.  Expected~S." xrecord1 record1))
 359         (and (equal xrecord0 record0)
 360              (equal xrecord1 record1))))))
 361
 362 ;;; --- end of file ---
 363