adding an optional argument to get-pure-port/headers

This commit is contained in:
Jay McCarthy 2012-08-16 14:45:51 -06:00
parent 65611c0ebb
commit a1e855a035
2 changed files with 12 additions and 5 deletions

View File

@ -316,14 +316,17 @@ empty string, or it will be a string matching the following regexp:
@defproc[(get-pure-port/headers @defproc[(get-pure-port/headers
[url url?] [url url?]
[headers (listof string?) '()] [headers (listof string?) '()]
[#:redirections redirections exact-nonnegative-integer? 0]) [#:redirections redirections exact-nonnegative-integer? 0]
[#:status? status? boolean? #f])
(values input-port? string?)]{ (values input-port? string?)]{
This function is an alternative to calling @racket[get-impure-port] and This function is an alternative to calling @racket[get-impure-port] and
@racket[purify-port] when needing to follow redirections. @racket[purify-port] when needing to follow redirections.
That is, it does a GET request on @racket[url], follows up to That is, it does a GET request on @racket[url], follows up to
@racket[redirections] redirections and returns a port containing @racket[redirections] redirections and returns a port containing
the data as well as the headers for the final connection. the data as well as the headers for the final connection. If
@racket[status?] is true, then the status line is included in the
result string.
} }
@defproc*[([(call/input-url [URL url?] @defproc*[([(call/input-url [URL url?]

View File

@ -216,7 +216,9 @@
(file://get-pure-port url)] (file://get-pure-port url)]
[else (url-error "Scheme ~a unsupported" scheme)]))) [else (url-error "Scheme ~a unsupported" scheme)])))
(define (get-pure-port/headers url [strings '()] #:redirections [redirections 0]) (define (get-pure-port/headers url [strings '()]
#:redirections [redirections 0]
#:status? [status? #f])
(let redirection-loop ([redirections redirections] [url url]) (let redirection-loop ([redirections redirections] [url url])
(define ip (define ip
(http://getpost-impure-port #t url #f strings)) (http://getpost-impure-port #t url #f strings))
@ -261,7 +263,9 @@
(close-input-port ip))) (close-input-port ip)))
(values in-pipe (values in-pipe
(apply string-append (map (λ (x) (string-append x "\r\n")) (apply string-append (map (λ (x) (string-append x "\r\n"))
(cons status (reverse headers)))))]))) (if status?
(cons status (reverse headers))
(reverse headers)))))])))
;; get-pure-port : url [x list (str)] -> in-port ;; get-pure-port : url [x list (str)] -> in-port
(define (get-pure-port url [strings '()] #:redirections [redirections 0]) (define (get-pure-port url [strings '()] #:redirections [redirections 0])
@ -700,7 +704,7 @@
(put-impure-port (->* (url? bytes?) ((listof string?)) input-port?)) (put-impure-port (->* (url? bytes?) ((listof string?)) input-port?))
(display-pure-port (input-port? . -> . void?)) (display-pure-port (input-port? . -> . void?))
(purify-port (input-port? . -> . string?)) (purify-port (input-port? . -> . string?))
(get-pure-port/headers (->* (url?) ((listof string?) #:redirections exact-nonnegative-integer?) (get-pure-port/headers (->* (url?) ((listof string?) #:redirections exact-nonnegative-integer? #:status? boolean?)
(values input-port? string?))) (values input-port? string?)))
(netscape/string->url (string? . -> . url?)) (netscape/string->url (string? . -> . url?))
(call/input-url (case-> (-> url? (call/input-url (case-> (-> url?