source: project/release/4/spiffy-request-vars/spiffy-request-vars.scm @ 17930

Last change on this file since 17930 was 17930, checked in by Mario Domenech Goulart, 9 years ago

spiffy-request-vars 0.4

  • `with-request-vars*' resurrected. For the cases when the syntax of

`with-request-vars' is ambiguous.

File size: 2.1 KB
Line 
1(module spiffy-request-vars (request-vars with-request-vars with-request-vars*)
2
3(import chicken scheme extras ports files data-structures)
4(use intarweb uri-common spiffy)
5
6(define (request-vars #!key (source 'both) max-content-length)
7  (let* ((content-matters? (not (memq (request-method (current-request)) '(GET HEAD))))
8         (get-vars (and (memq source '(both query-string))
9                        (uri-query (request-uri (current-request)))))
10         (request-body
11          (and (memq source '(both request-body))
12               content-matters? ;; don't bother reading the contents when method is either GET or HEAD
13               (let* ((headers (request-headers (current-request)))
14                      (content-length (header-value 'content-length headers)))
15                 (when (and max-content-length
16                            content-length ;; sometimes this header does not exist
17                            (> content-length max-content-length))
18                   (error 'request-vars "content-length exceeds the provided max-content-length."))
19                 (let ((body (read-string (or max-content-length content-length)
20                                          (request-port (current-request)))))
21                   (case (header-value 'content-type headers)
22                     ((application/x-www-form-urlencoded) (form-urldecode body))
23                     (else body)))))))
24
25    (lambda (var #!optional default (converter identity))
26      (let* ((var (if (string? var)
27                      (string->symbol var)
28                      var))
29             (val (or (and get-vars (alist-ref var get-vars))
30                      (and request-body (alist-ref var request-body)))))
31        (if val
32            (converter val)
33            default)))))
34
35(define-syntax with-request-vars
36  (syntax-rules ()
37    ((_ (var1 ...) e1 ...)
38     (let* ((% (request-vars))
39            (var1 (% (quote var1)))
40            ...)
41       e1 ...))))
42
43(define-syntax with-request-vars*
44  (syntax-rules ()
45    ((_ % (var1 ...) e1 ...)
46     (let* (($ %)
47            (var1 ($ (quote var1)))
48            ...)
49       e1 ...))))
50
51) ; end module
Note: See TracBrowser for help on using the repository browser.