diff --git a/extra/uu/authors.txt b/extra/uu/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/extra/uu/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/extra/uu/summary.txt b/extra/uu/summary.txt new file mode 100644 index 0000000000..676f165500 --- /dev/null +++ b/extra/uu/summary.txt @@ -0,0 +1 @@ +Support for uuencoding and uudecoding. diff --git a/extra/uu/uu-tests.factor b/extra/uu/uu-tests.factor new file mode 100644 index 0000000000..b8af167a43 --- /dev/null +++ b/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 diff --git a/extra/uu/uu.factor b/extra/uu/uu.factor new file mode 100644 index 0000000000..cc1bb58ab8 --- /dev/null +++ b/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 + + [ 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 ;