some tests added by mercora on Fri May 18 18:51:08 2012
#!/usr/bin/csi -s
(define (nntp:multi-line)
(call-with-input-file "samples/nntp.body.raw"
(lambda (nntp-in)
(with-input-from-port nntp-in
(lambda ()
(print "\t- just read")
(time (read-all))
(set-file-position! nntp-in 0)
(print "\t- string:read-line")
(time (nntp:multi-line:string:read-line))
(set-file-position! nntp-in 0)
(print "\t- port:list-buffered")
(time (nntp:multi-line:port:list-buffered))
(set-file-position! nntp-in 0)
(print "\t- port:vector-buffered")
(time (nntp:multi-line:port-vector-buffered)))))))
(use srfi-13)
(define (nntp:multi-line:string:read-line)
(let loop ((body "")
(current-line (read-line)))
(if (string= "." current-line)
body
(loop (string-append body current-line "\r\n") (read-line)))))
(use ports utils)
(use srfi-1)
(define (nntp:multi-line:port:list-buffered)
(read-all
(let ((buffer '())
(eof? #f))
(define (buffered-read)
(if (> (length buffer) 0)
(let ((bufferd-byte (car buffer)))
(set! buffer (drop buffer 1))
bufferd-byte)
(read-byte)))
(define (buffered-peek n)
(if (>= (length buffer) n)
(list-ref buffer (- n 1))
(begin
(set! n (- n (length buffer)))
(let loop ((i 1))
(if (> n i)
(begin
(set! buffer (append buffer (list (read-byte))))
(loop (+ i 1))))
(let ((peeked-byte (read-byte)))
(set! buffer (append buffer (list peeked-byte)))
peeked-byte)))))
(make-input-port
(lambda ()
(if eof?
#!eof
(let ((current-byte (buffered-read)))
(if (= current-byte 13)
(if (= (buffered-peek 1) 10)
(if (= (buffered-peek 2) 46)
(if (= (buffered-peek 3) 13)
(if (= (buffered-peek 4) 10)
(begin
(set! eof? #t)
#!eof)
current-byte)
current-byte)
current-byte)
current-byte)
current-byte))))
char-ready?
void))))
(define (nntp:multi-line:port-vector-buffered)
(read-all
(let ((buffer (make-vector 4))
(read-position -1)
(write-position 0)
(eof? #f))
(define (buffered-read)
(if (= read-position -1)
(begin
;(print "read native")
(read-byte))
(begin
;(print (format "read buffered from position ~A" read-position))
(let ((buffered-byte (vector-ref buffer read-position)))
(if (= read-position write-position)
(begin
;(print "reset buffer")
(set! write-position 0)
(set! read-position -1)
(set! buffered-byte (read-byte)))
(begin
;(print (format "moving cursor to ~A" (+ read-position 1)))
(set! read-position (+ read-position 1))))
buffered-byte))))
(define (buffered-peek n)
;(print (format "peek ~A" n))
(if (= read-position -1)
(set! read-position 0))
(let ((offset (- n 0)))
(if (>= write-position offset)
(begin
;(print (format "read buffered at ~A" offset))
(vector-ref buffer (- offset 1)))
(let ((bytes-count (- offset write-position)))
;(print (format "write ~Abytes at ~A" bytes-count write-position))
(let loop ((buffered-byte (read-byte)))
;(print (format "write ~A to buffer at ~A" buffered-byte write-position))
(vector-set! buffer write-position buffered-byte)
(set! write-position (+ write-position 1))
(if (= write-position offset)
(let ((buffer-offset (- offset 1)))
;(print (format "read buffered2 from ~A" buffer-offset))
(vector-ref buffer buffer-offset))
(loop)))))))
(make-input-port
(lambda ()
(if eof?
#!eof
(let ((current-byte (buffered-read)))
(if (= current-byte 13)
(if (= (buffered-peek 1) 10)
(if (= (buffered-peek 2) 46)
(if (= (buffered-peek 3) 13)
(if (= (buffered-peek 4) 10)
(begin
(set! eof? #t)
#!eof)
current-byte)
current-byte)
current-byte)
current-byte)
current-byte))))
char-ready?
void))))
(print "Testing multi-line parser")
(nntp:multi-line)