add multipart stream, actual multipart parsing to follow soon

diff --git a/basis/mime/multipart/authors.txt b/basis/mime/multipart/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/basis/mime/multipart/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/basis/mime/multipart/multipart-tests.factor b/basis/mime/multipart/multipart-tests.factor
new file mode 100644 (file)
index 0000000..e8a12ee
--- /dev/null
+++ b/basis/mime/multipart/multipart-tests.factor
@@ -0,0 +1,248 @@
+USING: accessors io io.streams.string kernel mime.multipart
+tools.test make multiline ;
+IN: mime.multipart.tests
+
+[ { "a" f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "a" f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "a" f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "a" f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "a" f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+
+[ { "a" "a" f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "aa" f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+
+
+[ { "a" f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "zz" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" "zz" } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "az" "zb" "zz" "cz" "zd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 2 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "a" "zzb" "zzc" "zzd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 3 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "az" "zbzz" "czzd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 4 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+[ { "azz" "bzzcz" "zd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 5 >>n
+        [ , ] [ ] multipart-step-loop drop
+    ] { } make
+] unit-test
+
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "a" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+
+[ { "a" "a" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 2 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 3 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 4 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "aa" f f "b" f f "c" f f "d" f f } ] [
+    [
+        "aazzbzzczzdzz" <string-reader> "z" <multipart-stream> 5 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+
+
+[ { "a" f "b" f "c" f "d" f } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "zz" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" "zz" } ] [
+    [
+        "azzbzzczzdzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "a" "z" "z" "b" "z" "z" "c" "z" "z" "d" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 1 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "az" "zb" "zz" "cz" "zd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 2 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "a" "zzb" "zzc" "zzd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 3 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "az" "zbzz" "czzd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 4 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test
+
+[ { "azz" "bzzcz" "zd" f } ] [
+    [
+        "azzbzzczzdzzz" <string-reader> "zzz" <multipart-stream> 5 >>n
+        [ , ] [ ] multipart-loop-all
+    ] { } make
+] unit-test

diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor
new file mode 100644 (file)
index 0000000..433e89e
--- /dev/null
+++ b/basis/mime/multipart/multipart.factor
@@ -0,0 +1,68 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators io kernel locals math multiline
+sequences splitting ;
+IN: mime.multipart
+
+TUPLE: multipart-stream stream n leftover separator ;
+
+: <multipart-stream> ( stream separator -- multipart-stream )
+    multipart-stream new
+        swap >>separator
+        swap >>stream
+        16 2^ >>n ;
+
+<PRIVATE
+
+: ?append ( seq1 seq2 -- newseq/seq2 )
+    over [ append ] [ nip ] if ;
+
+: ?cut* ( seq n -- before after )
+    over length over <= [ drop f swap ] [ cut* ] if ;
+    
+: read-n ( stream -- bytes end-stream? )
+    [ f ] change-leftover
+    [ n>> ] [ stream>> ] bi stream-read [ ?append ] keep not ;
+
+: multipart-split ( bytes separator -- before after ? empty? )
+    #! first boolean: return true if found
+    #! second boolean: true if sequence=
+    2dup sequence= [
+        2drop f f f t
+    ] [
+        split1 dup >boolean f
+    ] if ;
+
+PRIVATE>
+
+:: multipart-step ( stream bytes end-stream? separator quot: ( bytes -- ) -- ? end-stream? )
+    #! return t to loop again
+    bytes separator multipart-split [
+        ! separator == input
+        3drop f quot call f
+    ] [
+        [
+            ! found
+            [ [ quot call ] unless-empty ]
+            [
+                stream (>>leftover)
+                [ quot call ] unless-empty
+            ] if-empty f quot call f
+        ] [
+            ! not found
+            drop
+            end-stream? [
+                [ quot call ] unless-empty f
+            ] [
+                separator length 1- ?cut* stream (>>leftover)
+                [ quot call ] unless-empty t
+            ] if
+        ] if
+    ] if stream leftover>> end-stream? not or ;
+
+:: multipart-step-loop ( stream quot1: ( bytes -- ) quot2: ( -- ) -- ? )
+    stream dup [ read-n ] [ separator>> ] bi quot1 multipart-step
+    swap [ drop stream quot1 quot2 multipart-step-loop ] quot2 if ;
+
+: multipart-loop-all ( stream quot1: ( bytes -- ) quot2: ( -- ) -- )
+    3dup multipart-step-loop [ multipart-loop-all ] [ 3drop ] if ;