basis/io/crlf/crlf.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: byte-vectors io io.private kernel math namespaces sbufs
   4 sequences splitting ;
   5 IN: io.crlf
   6
   7 : crlf ( -- )
   8     "\r\n" write ;
   9
  10 :: stream-read-crlf ( stream -- seq )
  11     "\r" stream stream-read-until [
  12         CHAR: \r assert= stream stream-read1 CHAR: \n assert=
  13     ] [ f like ] if* ;
  14
  15 : read-crlf ( -- seq )
  16     input-stream get stream-read-crlf ;
  17
  18 :: stream-read-?crlf ( stream -- seq )
  19     "\r\n" stream stream-read-until [
  20         CHAR: \r = [ stream stream-read1 CHAR: \n assert= ] when
  21     ] [ f like ] if* ;
  22
  23 : read-?crlf ( -- seq )
  24     input-stream get stream-read-?crlf ;
  25
  26 : crlf>lf ( str -- str' )
  27     CHAR: \r swap remove ;
  28
  29 ! Note: can't use split-lines here
  30 : lf>crlf ( str -- str' )
  31     "\n" split "\r\n" join ;
  32
  33 :: stream-read1-ignoring-crlf ( stream -- ch )
  34     stream stream-read1 dup "\r\n" member?
  35     [ drop stream stream-read1-ignoring-crlf ] when ; inline recursive
  36
  37 : read1-ignoring-crlf ( -- ch )
  38     input-stream get stream-read1-ignoring-crlf ;
  39
  40 : push-ignoring-crlf ( elt seq -- )
  41     [ "\r\n" member? not ] swap push-if ;
  42
  43 : push-all-ignoring-crlf ( src dst -- )
  44     [ push-ignoring-crlf ] curry each ;
  45
  46 :: stream-read-ignoring-crlf ( n stream -- seq/f )
  47     n stream stream-read dup [
  48         dup [ "\r\n" member? ] any? [
  49             stream stream-element-type +byte+ =
  50             [ n <byte-vector> ] [ n <sbuf> ] if :> accum
  51             accum push-all-ignoring-crlf
  52
  53             [ accum length n < and ] [
  54                 n accum length - stream stream-read
  55                 [ accum push-all-ignoring-crlf ] keep
  56             ] do while
  57
  58             accum stream stream-exemplar like
  59         ] when
  60     ] when ;
  61
  62 : read-ignoring-crlf ( n -- seq/f )
  63     input-stream get stream-read-ignoring-crlf ;