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

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

spiffy-request-vars 0.3

Removed with-request-vars*'. with-request-vars accepts an optional
getter argument.

File size: 2.0 KB
Line 
1(module spiffy-request-vars (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    ((_ % (var1 ...) e1 ...)
43     (let* ((var1 (% (quote var1)))
44            ...)
45       e1 ...))))
46
47) ; end module
Note: See TracBrowser for help on using the repository browser.