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   (consume-leading-crap strm end-of-record)
 101   (if (eq (xpeek strm) strm)
 102       strm                              ; normal end-of-input
 103     ;; else, Let's collect fields until we have read an entire record.
 104     (prog1
 105         (loop until (member (xpeek strm) (list strm end-of-record))
 106               collect (prog1
 107                           (read-escaped-field strm
 108                                               (list strm field-separator
 109                                                     end-of-record)
 110                                               escape)
 111                         (when (eql (xpeek strm) field-separator)
 112                           ;; Consume the character which ended the field.
 113                           ;; Notice that we do not consume end-of-record
 114                           ;; characters.
 115                           (read-char strm))))
 116       (consume-leading-crap strm end-of-record))))
 117
 118 (defun load-escaped (pathname &key (field-separator *field-separator*)
 119                               (end-of-record *end-of-record*)
 120                               (escape *escape*)
 121                               (filter #'identity)
 122                               (trace nil))
 123   "Return the entire contents of an escaped DSV file as a list of
 124 records.  Each record is a list."
 125   (with-open-file (strm pathname :direction :input)
 126     (labels ((is-good (x) (funcall filter x))
 127              (xread () (read-escaped strm :field-separator field-separator
 128                                      :end-of-record end-of-record
 129                                      :escape escape)))
 130       (do ((lst () (if (is-good x) (cons x lst) lst))
 131            (x (xread) (xread))
 132            (i 0 (1+ i)))
 133           ((eq x strm) lst)
 134           (when (and trace (zerop (mod i 1000)))
 135             (format trace "~&~A: [~D] ~S" 'load-escaped i x))))))
 136
 137 ;;;
 138 ;;; todo: new new new.  Document me!!!
 139 ;;;
 140 (defmacro do-escaped ((var pathname) &body body)
 141   (let ((strm (gensym)))
 142     `(with-open-file (,strm ,pathname :element-type 'character
 143                             :direction :input :if-does-not-exist :error)
 144        (loop for ,var = (read-escaped ,strm)
 145              while (not (eq ,var ,strm))
 146              do (progn ,@body))
 147        (truename ,pathname))))
 148
 149 ;;;
 150 ;;; TESTS
 151 ;;;
 152
 153 (deftest test0000 ()
 154   "Null test.  Always succeeds."
 155   'test0000)
 156
 157 (deftest test0010 ()
 158   "Test that XPEEK returns the correct character from a stream, does
 159 not consume the character.  The character is NOT the last in the stream."
 160   (with-input-from-string (strm "abc")
 161     (and (eql (xpeek strm) #\a)
 162          (eql (read-char strm) #\a))))
 163
 164 (deftest test0011 ()
 165   "Like TEST0011 except that it tests XPEEK on the last character in the
 166 stream.  In other words, tests that XPEEK returns the correct value &
 167 does not consume it, & that character is the last in the stream."
 168   (with-input-from-string (strm "c")
 169     (and (eql (xpeek strm) #\c)
 170          (eql (read-char strm) #\c))))
 171
 172 (deftest test0012 ()
 173   "Test XPEEK on an empty stream."
 174   (with-input-from-string (strm "")
 175     (and (eq (xpeek strm) strm)
 176          (eq (read-char strm nil strm) strm))))
 177
 178 (deftest test0015 ()
 179   "Test CONSUME-LEADING-CRAP on a stream that contains nothing but leading
 180 crap."
 181   (with-input-from-string (strm (format nil "~%~%~%"))
 182     (and (eql (xpeek strm) #\Newline)   ; not at end
 183          (consume-leading-crap strm #\Newline) ; doesn't matter what it returns
 184          (eq (read-char strm nil strm) strm)))) ; now we're at end
 185
 186 (deftest test0016 ()
 187   "Test CONSUME-LEADING-CRAP on a streeam that starts with leading crap,
 188 then has some non-crap."
 189   (with-input-from-string (strm (format nil "~%~%~%a"))
 190     (and (eql (xpeek strm) #\Newline)   ; not at end
 191          (consume-leading-crap strm #\Newline) ; doesn't matter what it returns
 192          (eql (read-char strm) #\a))))
 193
 194 (deftest test0017 ()
 195   "Test CONSUME-LEADING-CRAP on a stream that starts with non-crap, then
 196 has some crap.  CONSUME-LEADING-CRAP should not consume the leading
 197 non-crap."
 198   (with-input-from-string (strm (format nil "a~%"))
 199     (and (eql (xpeek strm) #\a)         ; not at end
 200          (consume-leading-crap strm #\Newline) ; doesn't matter what it returns
 201          (eql (read-char strm) #\a))))  ; the "a" char should remain
 202
 203 (deftest test0020 ()
 204   "Test READ-ESCAPED-FIELD on a stream that contains a single field
 205 followed by end-of-input.  Uses the default field separator, end-of-record
 206 character, & escape character.  Just test that the field is read, not that
 207 the next READ-ESCAPED-FIELD indicates end-of-input."
 208   (with-input-from-string (strm "abc")
 209     (equal (read-escaped-field strm
 210                                (list strm *field-separator* *end-of-record*)
 211                                *escape*)
 212            "abc")))
 213
 214 (deftest test0021 ()
 215   "Like TEST0020, but also checks that another call to READ-ESCAPED-FIELD
 216 indicates end-of-input by returning STRM."
 217   (with-input-from-string (strm "abc")
 218     (let* ((a (read-escaped-field strm
 219                                   (list strm *field-separator* *end-of-record*)
 220                                   *escape*))
 221            (b (read-escaped-field strm
 222                                   (list strm *field-separator* *end-of-record*)
 223                                   *escape*)))
 224       (unless (equal a "abc")
 225         (format t "~&~A: First read should have returned" 'test0021)
 226         (format t " ~S, but it returned ~S" "abc" a))
 227       (unless (eq b strm)
 228         (format t "~&~A: Second read should have returned" 'test0021)
 229         (format t " ~S, but it returned ~S" strm b))
 230       (and (equal a "abc") (eq b strm)))))
 231
 232 (deftest test0025 ()
 233   "Test that READ-ESCAPED-FIELD works on two consecutive fields."
 234   (let ((a "abc") (b "xyz"))
 235     (with-input-from-string (strm (format nil "~A~A~A" a *field-separator* b))
 236       (let* ((terminators (list strm *field-separator* *end-of-record*))
 237              (xa (read-escaped-field strm terminators *escape*))
 238              (xseparator (read-char strm))
 239              (xb (read-escaped-field strm terminators *escape*))
 240              (xstrm (xpeek strm)))
 241         (and (equal xa a) (eql xseparator *field-separator*) (equal xb b)
 242              (eq xstrm strm))))))
 243
 244 (deftest test0026 ()
 245   "Test that READ-ESCAPED-FIELD works on two records of two fields each.
 246 The second record does not end with an end-of-record character.  It
 247 ends with end-of-input on the stream."
 248   (let* ((a "abc") (b "123")            ; first record
 249          (c "def") (d "456")            ; second record
 250          (string (format nil "~A~A~A~A~A~A~A" a *field-separator* b
 251                          *end-of-record* c *field-separator* d)))
 252     (with-input-from-string (strm string)
 253       (let* ((terminators (list strm *field-separator* *end-of-record*))
 254              (xa (read-escaped-field strm terminators *escape*))
 255              (xseparator0 (read-char strm))
 256              (xb (read-escaped-field strm terminators *escape*))
 257              (xend-of-record0 (read-char strm))
 258              (xc (read-escaped-field strm terminators *escape*))
 259              (xseparator1 (read-char strm))
 260              (xd (read-escaped-field strm terminators *escape*))
 261              (xstrm (xpeek strm)))
 262         (and (equal xa a)
 263              (eql xseparator0 *field-separator*)
 264              (equal xb b)
 265              (eql xend-of-record0 *end-of-record*)
 266              (equal xc c)
 267              (eql xseparator1 *field-separator*)
 268              (equal xd d)
 269              (eq xstrm strm))))))
 270
 271 (deftest test0027 ()
 272   "Like TEST0026 except that the second record ends with an end-of-
 273 record character."
 274   (let* ((a "abc") (b "123")            ; first record
 275          (c "def") (d "456")            ; second record
 276          (string (format nil "~A~A~A~A~A~A~A~A" a *field-separator* b
 277                          *end-of-record* c *field-separator* d
 278                          *end-of-record*)))
 279     (with-input-from-string (strm string)
 280       (let* ((terminators (list strm *field-separator* *end-of-record*))
 281              (xa (read-escaped-field strm terminators *escape*))
 282              (xseparator0 (read-char strm))
 283              (xb (read-escaped-field strm terminators *escape*))
 284              (xend-of-record0 (read-char strm))
 285              (xc (read-escaped-field strm terminators *escape*))
 286              (xseparator1 (read-char strm))
 287              (xd (read-escaped-field strm terminators *escape*))
 288              (xend-of-record1 (read-char strm))
 289              (xstrm (xpeek strm)))
 290         (and (equal xa a)
 291              (eql xseparator0 *field-separator*)
 292              (equal xb b)
 293              (eql xend-of-record0 *end-of-record*)
 294              (equal xc c)
 295              (eql xseparator1 *field-separator*)
 296              (equal xd d)
 297              (eql xend-of-record1 *end-of-record*)
 298              (eq xstrm strm))))))
 299
 300 (deftest test0050 ()
 301   "Test READ-ESCAPED on an input stream containing a single record of a
 302 single field."
 303   (let* ((record (list "abc"))
 304          (string (format nil "~A" (first record))))
 305     (with-input-from-string (strm string)
 306       (let* ((xrecord (read-escaped strm))
 307              (xstrm (xpeek strm)))
 308         (and (equal xrecord record)
 309              (eq xstrm strm))))))
 310
 311 (deftest test0051 ()
 312   "Test READ-ESCAPED on an input stream containing a single record of two
 313 fields."
 314   (let* ((record (list "abc" "123"))
 315          (string (format nil "~A~A~A" (first record) *field-separator*
 316                          (second record))))
 317     (with-input-from-string (strm string)
 318       (let* ((xrecord (read-escaped strm))
 319              (xstrm (xpeek strm)))
 320         (and (equal xrecord record)
 321              (eq xstrm strm))))))
 322
 323 (deftest test0052 ()
 324   "Test READ-ESCAPED.  After reading the single record of two fields,
 325 the stream should be at its end.  The record is followed by several
 326 end-of-record characters, & the stream should be at its end after
 327 reading the record because no records follow the record terminators."
 328   (let* ((record (list "abc" "123"))
 329          (string (format nil "~A~A~A~A~A~A" (first record) *field-separator*
 330                          (second record) *end-of-record* *end-of-record*
 331                          *end-of-record*)))
 332     (with-input-from-string (strm string)
 333       (let* ((xrecord (read-escaped strm))
 334              (xstrm (xpeek strm)))
 335         (and (equal xrecord record)
 336              (eq xstrm strm))))))
 337
 338 (deftest test0053 ()
 339   "Test READ-ESCAPED on an input of two, two-field records.  The second
 340 record is followed by one end-of-record character."
 341   (let ((record0 '("aaa" "111"))
 342         (record1 '("bbb" "222"))
 343         (string (format nil "aaa~A111~Abbb~A222~A"
 344                         *field-separator* *end-of-record*
 345                         *field-separator* *end-of-record*)))
 346     (with-input-from-string (strm string)
 347       (let* ((xrecord0 (read-escaped strm))
 348              (xrecord1 (read-escaped strm)))
 349         (unless (equal xrecord0 record0)
 350           (format t "~&First record is ~S.  Expected ~S." xrecord0 record0))
 351         (unless (equal xrecord1 record1)
 352           (format t "~&Second record is ~S.  Expected~S." xrecord1 record1))
 353         (and (equal xrecord0 record0)
 354              (equal xrecord1 record1))))))
 355
 356 ;;; --- end of file ---
 357