uu: support for uuencoding and uudecoding.

extra/uu/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

extra/uu/summary.txt

@@ -0,0 +1 @@
+Support for uuencoding and uudecoding.

extra/uu/uu-tests.factor

@@ -0,0 +1,21 @@
+
+USING: io.streams.string kernel tools.test ;
+
+IN: uu
+
+CONSTANT: plain
+"The smooth-scaled python crept over the sleeping dog"
+
+CONSTANT: encoded
+"""begin
+M5&AE('-M;V]T:"US8V%L960@<'ET:&]N(&-R97!T(&]V97(@=&AE('-L965P
+':6YG(&1O9P  
+end
+"""
+
+{ t } [ plain string>uu encoded = ] unit-test
+{ t } [ encoded uu>string plain = ] unit-test
+
+{ "Cat" } [
+    "begin 644 cat.txt\n#0V%T\n`\nend\n" uu>string
+] unit-test

extra/uu/uu.factor

@@ -0,0 +1,93 @@
+! Copyright (C) 2013 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: combinators.short-circuit io io.streams.string kernel
+locals make math math.bitwise namespaces sequences ;
+
+IN: uu
+
+<PRIVATE
+
+ERROR: bad-length seq ;
+
+: check-length ( seq -- seq )
+    dup length 45 > [ bad-length ] when ; inline
+
+:: binary>ascii ( seq -- seq' )
+    0 :> char!
+    0 :> bits!
+    seq check-length [
+        dup length CHAR: \s + ,
+
+        [ dup empty? bits zero? and ] [
+
+            char 8 shift char!
+            bits 8 + bits!
+
+            dup empty? [
+                unclip-slice char bitor char!
+            ] unless
+
+            [ bits 6 >= ] [
+                bits 6 -
+                [ char swap neg shift 0x3f bitand CHAR: \s + , ]
+                [ bits! ] bi
+            ] while
+
+        ] until drop
+    ] "" make ;
+
+ERROR: illegal-character ch ;
+
+: check-illegal-character ( ch -- ch )
+    dup { [ CHAR: \s < ] [ CHAR: \s 64 + > ] } 1||
+    [ illegal-character ] when ;
+
+:: ascii>binary ( seq -- seq' )
+    0 :> char!
+    0 :> bits!
+
+    seq unclip-slice dup CHAR: \s =
+    [ drop 0 ] [ CHAR: \s - ] if :> len!
+
+    [
+        [ dup empty? not len 0 > and ] [
+            dup empty? [ 0 ] [ unclip-slice ] if
+            dup "\r\n\0" member? [
+                drop 0
+            ] [
+                check-illegal-character
+                CHAR: \s -
+            ] if
+
+            char 6 shift bitor char!
+            bits 6 + bits!
+
+            bits 8 >= [
+                bits 8 -
+                [ char swap neg shift 0xff bitand , ]
+                [ on-bits char bitand char! ]
+                [ bits! ] tri
+                len 1 - len!
+            ] when
+        ] while drop
+
+    ] "" make ;
+
+PRIVATE>
+
+: uu-encode ( -- )
+    "begin" print
+    input-stream get [ binary>ascii print ] 45 (each-stream-block)
+    "end" print ;
+
+: string>uu ( seq -- seq' )
+    [ [ uu-encode ] with-string-writer ] with-string-reader ;
+
+: uu-decode ( -- )
+    [ "begin" head? ] [ readln ] do until
+    [ dup "end" head? [ drop t ] [ ascii>binary write f ] if ]
+    [ readln ] do until ;
+
+: uu>string ( seq -- seq )
+    [ [ uu-decode ] with-string-writer ] with-string-reader ;