[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/8q3sQGzA    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Mar 6:
; READ-CSV-RECORD [DELIM] [PORT] 
(define (read-csv-record . args) 
  (define (read-csv delim port) 
    (define (add-field field fields) 
      (cons (list->string (reverse field)) fields)) 
    (define (start field fields) 
      (let ((c (read-char port))) 
        (cond ((eof-object? c) (reverse fields)) 
              ((char=? #\return c) (carriage-return field fields)) 
              ((char=? #\newline c) (line-feed field fields)) 
              ((char=? #\" c) (quoted-field field fields)) 
              ((char=? delim c) (not-field '() (add-field field fields))) 
              (else (unquoted-field (cons c field) fields))))) 
    (define (not-field field fields) 
      (let ((c (read-char port))) 
        (cond ((eof-object? c) (cons "" fields)) 
              ((char=? #\return c) (carriage-return '() (add-field field fields))) 
              ((char=? #\newline c) (line-feed '() (add-field field fields))) 
              ((char=? #\" c) (quoted-field field fields)) 
              ((char=? delim c) (not-field '() (add-field field fields))) 
              (else (unquoted-field (cons c field) fields))))) 
    (define (quoted-field field fields) 
      (let ((c (read-char port))) 
        (cond ((eof-object? c) (add-field field fields)) 
              ((char=? #\" c) (may-be-doubled-quotes field fields)) 
              (else (quoted-field (cons c field) fields))))) 
    (define (may-be-doubled-quotes field fields) 
      (let ((c (read-char port))) 
        (cond ((eof-object? c) (add-field field fields)) 
              ((char=? #\return c) (carriage-return '() (add-field field fields))) 
              ((char=? #\newline c) (line-feed '() (add-field field fields))) 
              ((char=? #\" c) (quoted-field (cons #\" field) fields)) 
              ((char=? delim c) (not-field '() (add-field field fields))) 
              (else (unquoted-field (cons c field) fields))))) 
    (define (unquoted-field field fields) 
      (let ((c (read-char port))) 
        (cond ((eof-object? c) (add-field field fields)) 
              ((char=? #\return c) (carriage-return '() (add-field field fields))) 
              ((char=? #\newline c) (line-feed '() (add-field field fields))) 
              ((char=? delim c) (not-field '() (add-field field fields))) 
              (else (unquoted-field (cons c field) fields))))) 
    (define (carriage-return field fields) 
      (let ((c (peek-char port))) 
        (cond ((eof-object? c) fields) 
              ((char=? #\newline c) (read-char port) fields) 
              (else fields)))) 
    (define (line-feed field fields) 
      (let ((c (peek-char port))) 
        (cond ((eof-object? c) fields) 
              ((char=? #\return c) (read-char port) fields) 
              (else fields)))) 
    (if (eof-object? (peek-char port)) (peek-char port) (reverse (start '() '())))) 
  (cond ((null? args) (read-csv #\, (current-input-port))) 
        ((and (null? (cdr args)) (char? (car args))) 
          (read-csv (car args) (current-input-port))) 
        ((and (null? (cdr args)) (port? (car args))) 
          (read-csv #\, (car args))) 
        ((and (pair? (cdr args)) (null? (cddr args)) (char? (car args)) (port? (cadr args))) 
          (read-csv (car args) (cadr args))) 
        (else (read-csv #\, (current-input-port)))))

(define csv-test (string-append
  "1,abc,def ghi,jkl,unquoted character strings\n"
  "2,\"abc\",\"def ghi\",\"jkl\",quoted character strings\n"
  "3,123,456,789,numbers\n"
  "4,   abc,def   ,   ghi   ,strings with whitespace\n"
  "5,   \"abc\",\"def\"   ,   \"ghi\"   ,quoted strings with whitespace\n"
  "6,   123,456   ,   789   ,numbers with whitespace\n"
  "7,TAB123,456TAB,TAB789TAB,numbers with tabs for whitespace\n"
  "8,   -123,   +456,   1E3,more numbers with whitespace\n"
  "9,123 456,123\"456,  123 456   ,strange numbers\n"
  "10,abc\",de\"f,g\"hi,embedded quotes\n"
  "11,\"abc\"\"\",\"de\"\"f\",\"g\"\"hi\",quoted embedded quotes\n"
  "12,\"\",\"\" \"\",\"\"x\"\",doubled quotes\n"
  "13,\"abc\"def,abc\"def\",\"abc\" \"def\",strange quotes\n"
  "14,,\"\",   ,empty fields\n"
  "15,abc,\"def\n  ghi\",jkl,embedded newline\n"
  "16,abc,\"def\",789,multiple types of fields\n"))

(with-input-from-string csv-test (lambda ()
  (do ((csv-record (read-csv-record) (read-csv-record)))
      ((eof-object? csv-record))
    (display (list-ref csv-record 0)) (display "|")
    (display (list-ref csv-record 1)) (display "|")
    (display (list-ref csv-record 2)) (display "|")
    (display (list-ref csv-record 3)) (display "|")
    (display (list-ref csv-record 4)) (newline))))


Output:
1
reference to undefined identifier: with-input-from-string


Create a new paste based on this one


Comments: