Welcome to the CHICKEN Scheme pasting service

call-with-input-request* added by mario-goulart on Fri Dec 12 22:41:52 2014

diff --git a/http-client.scm b/http-client.scm
index 6dde277..3a80422 100644
--- a/http-client.scm
+++ b/http-client.scm
@@ -34,7 +34,8 @@
 (module http-client
   (max-retry-attempts max-redirect-depth retry-request? client-software
    close-connection! close-all-connections!
-   call-with-input-request with-input-from-request call-with-response
+   call-with-input-request call-with-input-request*
+   with-input-from-request call-with-response
    store-cookie! delete-cookie! get-cookies-for-uri
    http-authenticators get-username/password
    basic-authenticator digest-authenticator
@@ -690,7 +691,7 @@
                    chunks))
            0 entries))))
 
-(define (call-with-input-request uri-or-request writer reader)
+(define (call-with-input-request-base uri-or-request writer reader single-arg-reader?)
   (let* ((type #f)
          (uri (cond ((uri? uri-or-request) uri-or-request)
                     ((string? uri-or-request) (uri-reference uri-or-request))
@@ -742,12 +743,17 @@
               (finish-request-body r)))
            (else (lambda x (void))))
      (lambda (response)
-       (let ((port (make-delimited-input-port
-                    (response-port response)
-                    (header-value 'content-length (response-headers response))))
-             (body? ((response-has-message-body-for-request?) response req)))
+       (let* ((resp-headers (response-headers response))
+              (port (make-delimited-input-port
+                     (response-port response)
+                     (header-value 'content-length resp-headers)))
+              (body? ((response-has-message-body-for-request?) response req)))
          (if (= 200 (response-class response)) ; Everything cool?
-             (let ((result (and body? reader (reader port))))
+             (let ((result (and body?
+                                reader
+                                (if single-arg-reader?
+                                    (reader port)
+                                    (reader port resp-headers)))))
                (when body? (discard-remaining-data! #f port))
                result)
              (http-client-error
@@ -768,6 +774,12 @@
               'response response
               'body (and body? (read-string #f port)))))))))
 
+(define (call-with-input-request uri-or-request writer reader)
+  (call-with-input-request-base uri-or-request writer reader #t))
+
+(define (call-with-input-request* uri-or-request writer reader)
+  (call-with-input-request-base uri-or-request writer reader #f))
+
 (define (with-input-from-request uri-or-request writer reader)
   (call-with-input-request uri-or-request
                            (if (procedure? writer)

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
Which egg provides `string-pad-right'?
Visually impaired? Let me spell it for you (wav file) download WAV