diff options
author | Andy Wingo <wingo@pobox.com> | 2011-04-11 23:30:52 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-04-11 23:30:52 +0200 |
commit | 21c05db45b69f8a62b84c36abc86cb935fa967d7 (patch) | |
tree | 743df01da540e7fd628f54894e7d5fbe94b03996 /module/web/server.scm | |
parent | 4db853d747ac115f799c93e2de93f5159ad84109 (diff) | |
parent | c89b45299329d034875429804f18768c1ea96713 (diff) | |
download | guile-21c05db45b69f8a62b84c36abc86cb935fa967d7.tar.gz |
Merge remote branch 'origin/stable-2.0'
Conflicts:
GUILE-VERSION
test-suite/tests/srfi-4.test
Diffstat (limited to 'module/web/server.scm')
-rw-r--r-- | module/web/server.scm | 33 |
1 files changed, 24 insertions, 9 deletions
diff --git a/module/web/server.scm b/module/web/server.scm index 4715cae69..c5e623a19 100644 --- a/module/web/server.scm +++ b/module/web/server.scm @@ -75,7 +75,7 @@ (define-module (web server) #:use-module (srfi srfi-9) #:use-module (rnrs bytevectors) - #:use-module (rnrs io ports) + #:use-module (ice-9 binary-ports) #:use-module (web request) #:use-module (web response) #:use-module (system repl error-handling) @@ -167,18 +167,33 @@ values." (warn "Error while accepting client" k args) (values #f #f #f)))) +;; like call-with-output-string, but actually closes the port (doh) +(define (call-with-output-string* proc) + (let ((port (open-output-string))) + (proc port) + (let ((str (get-output-string port))) + (close-port port) + str))) + +(define (call-with-output-bytevector* proc) + (call-with-values + (lambda () + (open-bytevector-output-port)) + (lambda (port get-bytevector) + (proc port) + (let ((bv (get-bytevector))) + (close-port port) + bv)))) + (define (call-with-encoded-output-string charset proc) (if (string-ci=? charset "utf-8") ;; I don't know why, but this appears to be faster; at least for ;; examples/debug-sxml.scm (1464 reqs/s versus 850 reqs/s). - (string->utf8 (call-with-output-string proc)) - (call-with-values - (lambda () - (open-bytevector-output-port)) - (lambda (port get-bytevector) - (set-port-encoding! port charset) - (proc port) - (get-bytevector))))) + (string->utf8 (call-with-output-string* proc)) + (call-with-output-bytevector* + (lambda (port) + (set-port-encoding! port charset) + (proc port))))) (define (encode-string str charset) (if (string-ci=? charset "utf-8") |