basis/quoted-printable/quoted-printable.factor

   1 ! Copyright (C) 2009 Daniel Ehrenberg
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: sequences strings kernel io.encodings.string
   4 math.order ascii math io io.encodings.utf8 io.streams.string
   5 combinators.short-circuit math.parser arrays ;
   6 IN: quoted-printable
   7
   8 ! This implements RFC 2045 section 6.7
   9
  10 <PRIVATE
  11
  12 : assure-small ( ch -- ch )
  13     dup 256 <
  14     [ "Cannot quote a character greater than 255" throw ] unless ;
  15
  16 : printable? ( ch -- ? )
  17     {
  18         [ CHAR: \s CHAR: < between? ]
  19         [ CHAR: > CHAR: ~ between? ]
  20         [ CHAR: \t = ]
  21     } 1|| ;
  22
  23 : char>quoted ( ch -- str )
  24     dup printable? [ 1string ] [
  25         assure-small >hex >upper
  26         2 CHAR: 0 pad-head
  27         CHAR: = prefix
  28     ] if ;
  29
  30 : take-some ( seqs -- seqs seq )
  31     0 over [ length + dup 76 >= ] find drop nip
  32     [ 1 - cut-slice swap ] [ f swap ] if* concat ;
  33
  34 : divide-lines ( strings -- strings )
  35     [ dup ] [ take-some ] produce nip ;
  36
  37 PRIVATE>
  38
  39 : >quoted ( byte-array -- string )
  40     [ char>quoted ] { } map-as concat "" like ;
  41
  42 : >quoted-lines ( byte-array -- string )
  43     [ char>quoted ] { } map-as
  44     divide-lines "=\r\n" join ;
  45
  46 <PRIVATE
  47
  48 : read-char ( byte -- ch )
  49     dup CHAR: = = [
  50        drop read1 dup CHAR: \n =
  51        [ drop read1 read-char ]
  52        [ read1 2array hex> ] if
  53     ] when ;
  54
  55 : read-quoted ( -- bytes )
  56     [ read1 dup ] [ read-char ] B{ } produce-as nip ;
  57
  58 PRIVATE>
  59
  60 : quoted> ( string -- byte-array )
  61     ! Input should already be normalized to make \r\n into \n
  62     [ read-quoted ] with-string-reader ;