summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2018-09-12 17:25:45 +0530
committerArun Isaac2018-09-12 17:25:45 +0530
commit959941b87c2e7ba732cae8ad1943432dfba83427 (patch)
tree5f55c80b01d6c73e027b7cf8b2b63aaeb142ddd9
parentdc63650fc9a1617933d7076961a52408ba0d54fd (diff)
downloadguile-email-959941b87c2e7ba732cae8ad1943432dfba83427.tar.gz
guile-email-959941b87c2e7ba732cae8ad1943432dfba83427.tar.lz
guile-email-959941b87c2e7ba732cae8ad1943432dfba83427.zip
quoted-printable: Add quoted-printable-encode.
* email/quoted-printable.scm (quoted-printable-encode): New function. * tests/quoted-printable.scm (quoted-printable wikipedia example): Rename to ... (quoted-printable wikipedia example: decoding): ... this. (quoted-printable wikipedia example: encoding, quoted-printable wikipedia example: encoded output should not be more than 76 columns wide): New tests.
-rw-r--r--email/quoted-printable.scm33
-rwxr-xr-xtests/quoted-printable.scm26
2 files changed, 54 insertions, 5 deletions
diff --git a/email/quoted-printable.scm b/email/quoted-printable.scm
index 317bf81..d084a7e 100644
--- a/email/quoted-printable.scm
+++ b/email/quoted-printable.scm
@@ -19,8 +19,11 @@
(define-module (email quoted-printable)
#:use-module (rnrs)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-26)
#:export (quoted-printable-decode
+ quoted-printable-encode
q-encoding-decode))
;; TODO: Error out on invalid quoted-printable input
@@ -49,6 +52,36 @@
(else (put-u8 out (char->integer c))
(quoted-printable-decode in out)))))))
+(define quoted-printable-encode
+ (match-lambda*
+ (((? bytevector? bv))
+ (call-with-port (open-bytevector-input-port bv)
+ quoted-printable-encode))
+ (((? port? in))
+ (call-with-output-string
+ (cut quoted-printable-encode in <>)))
+ (((? port? in) (? port? out))
+ (quoted-printable-encode in out 76))
+ (((? port? in) (? port? out) (? integer? number-of-chars-left-on-this-line))
+ (let ((x (get-u8 in))
+ (put-into-output
+ (lambda (str)
+ (let* ((len (string-length str))
+ (break-line? (<= number-of-chars-left-on-this-line len)))
+ (put-string
+ out (string-append (if break-line? "=\n" "") str))
+ (if break-line?
+ (- 76 len)
+ (- number-of-chars-left-on-this-line len))))))
+ (unless (eof-object? x)
+ (let ((c (integer->char x)))
+ (quoted-printable-encode
+ in out
+ (put-into-output
+ (if (char-set-contains?
+ (char-set-delete char-set:ascii #\newline #\return) c)
+ (string c)
+ (format #f "=~:@(~2,'0x~)" x))))))))))
(define (q-encoding-decode str)
(quoted-printable-decode
diff --git a/tests/quoted-printable.scm b/tests/quoted-printable.scm
index c57c833..cc1b957 100755
--- a/tests/quoted-printable.scm
+++ b/tests/quoted-printable.scm
@@ -19,19 +19,35 @@
(use-modules (email quoted-printable)
(ice-9 iconv)
+ (srfi srfi-1)
(srfi srfi-64))
(test-begin "quoted-printable")
-(test-equal "quoted-printable wikipedia example"
- (bytevector->string
- (quoted-printable-decode "J'interdis aux marchands de vanter trop leur marchandises. Car ils se font =
+(let ((decoded-text
+ "J'interdis aux marchands de vanter trop leur marchandises. Car ils se font vite pédagogues et t'enseignent comme but ce qui n'est par essence qu'un moyen, et te trompant ainsi sur la route à suivre les voilà bientôt qui te dégradent, car si leur musique est vulgaire ils te fabriquent pour te la vendre une âme vulgaire.")
+ (encoded-text
+ "J'interdis aux marchands de vanter trop leur marchandises. Car ils se font =
vite p=C3=A9dagogues et t'enseignent comme but ce qui n'est par essence qu'=
un moyen, et te trompant ainsi sur la route =C3=A0 suivre les voil=C3=A0 bi=
ent=C3=B4t qui te d=C3=A9gradent, car si leur musique est vulgaire ils te f=
abriquent pour te la vendre une =C3=A2me vulgaire.")
- "UTF-8")
- "J'interdis aux marchands de vanter trop leur marchandises. Car ils se font vite pédagogues et t'enseignent comme but ce qui n'est par essence qu'un moyen, et te trompant ainsi sur la route à suivre les voilà bientôt qui te dégradent, car si leur musique est vulgaire ils te fabriquent pour te la vendre une âme vulgaire.")
+ (charset "UTF-8"))
+ (test-equal "quoted-printable wikipedia example: decoding"
+ (bytevector->string (quoted-printable-decode encoded-text) charset)
+ decoded-text)
+
+ (test-equal "quoted-printable wikipedia example: encoding"
+ (quoted-printable-encode
+ (string->bytevector decoded-text charset))
+ encoded-text)
+
+ (test-assert "quoted-printable wikipedia example: encoded output should not be more than 76 columns wide"
+ (every (lambda (line)
+ (<= (string-length line) 76))
+ (string-split (quoted-printable-encode
+ (string->bytevector decoded-text charset))
+ #\newline))))
(test-equal "q-encoding wikipedia example"
(bytevector->string