diff --git a/basis/io/crlf/crlf-tests.factor b/basis/io/crlf/crlf-tests.factor index c366f35242..f23eb55b63 100644 --- a/basis/io/crlf/crlf-tests.factor +++ b/basis/io/crlf/crlf-tests.factor @@ -13,3 +13,16 @@ USING: io.crlf tools.test io.streams.string io ; { "foo\nbar" } [ "foo\n\rbar" crlf>lf ] unit-test { "foo\r\nbar" } [ "foo\nbar" lf>crlf ] unit-test + +{ f } [ "" [ read1-ignoring-crlf ] with-string-reader ] unit-test +{ CHAR: a } [ "a" [ read1-ignoring-crlf ] with-string-reader ] unit-test +{ CHAR: b } [ "\nb" [ read1-ignoring-crlf ] with-string-reader ] unit-test +{ CHAR: c } [ "\r\nc" [ read1-ignoring-crlf ] with-string-reader ] unit-test + +{ f } [ "" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "a" } [ "a" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "ab" } [ "a\nb" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abc" } [ "a\nb\r\nc" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abcd" } [ "a\nb\r\ncd" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abcde" } [ "a\nb\r\ncd\r\ne" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test +{ "abcde" } [ "a\nb\r\ncd\r\ne\nfghi" [ 5 read-ignoring-crlf ] with-string-reader ] unit-test diff --git a/basis/io/crlf/crlf.factor b/basis/io/crlf/crlf.factor index f68c763422..9ab6f7dff9 100644 --- a/basis/io/crlf/crlf.factor +++ b/basis/io/crlf/crlf.factor @@ -1,21 +1,62 @@ ! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: io kernel sequences splitting ; +USING: byte-vectors io io.private kernel locals math namespaces +sbufs sequences splitting ; IN: io.crlf : crlf ( -- ) "\r\n" write ; +:: stream-read-crlf ( stream -- seq ) + "\r" stream stream-read-until [ + CHAR: \r assert= stream stream-read1 CHAR: \n assert= + ] [ f like ] if* ; + : read-crlf ( -- seq ) - "\r" read-until - [ CHAR: \r assert= read1 CHAR: \n assert= ] [ f like ] if* ; + input-stream get stream-read-crlf ; + +:: stream-read-?crlf ( stream -- seq ) + "\r\n" stream stream-read-until [ + CHAR: \r = [ stream stream-read1 CHAR: \n assert= ] when + ] [ f like ] if* ; : read-?crlf ( -- seq ) - "\r\n" read-until - [ CHAR: \r = [ read1 CHAR: \n assert= ] when ] [ f like ] if* ; + input-stream get stream-read-?crlf ; : crlf>lf ( str -- str' ) CHAR: \r swap remove ; : lf>crlf ( str -- str' ) "\n" split "\r\n" join ; + +:: stream-read1-ignoring-crlf ( stream -- ch ) + stream stream-read1 dup "\r\n" member? + [ drop stream stream-read1-ignoring-crlf ] when ; inline recursive + +: read1-ignoring-crlf ( -- ch ) + input-stream get stream-read1-ignoring-crlf ; + +: push-ignoring-crlf ( elt seq -- ) + [ "\r\n" member? not ] swap push-if ; + +: push-all-ignoring-crlf ( src dst -- ) + [ push-ignoring-crlf ] curry each ; + +:: stream-read-ignoring-crlf ( n stream -- seq/f ) + n stream stream-read dup [ + dup [ "\r\n" member? ] any? [ + stream stream-element-type +byte+ = + [ n ] [ n ] if :> accum + accum push-all-ignoring-crlf + + [ accum length n < and ] [ + n accum length - stream stream-read + [ accum push-all-ignoring-crlf ] keep + ] do while + + accum stream stream-exemplar like + ] when + ] when ; + +: read-ignoring-crlf ( n -- seq/f ) + input-stream get stream-read-ignoring-crlf ;