Changeset 17991 in project


Ignore:
Timestamp:
05/04/10 01:08:10 (10 years ago)
Author:
Mario Domenech Goulart
Message:

spiffy-request-vars (trunk)

  • syntax changes
  • added as-list', as-number' and `as-boolean' as converter

procedures. The `true-boolean-values' parameter specify which strings
are to be considered `#t' when passed through the URL and converted
with `as-boolean'.

  • with-request-vars' and with-request-vars*' admit specifying a

converter to variables values

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/spiffy-request-vars/trunk/spiffy-request-vars.scm

    r17989 r17991  
    1 (module spiffy-request-vars (request-vars with-request-vars with-request-vars*)
     1(module spiffy-request-vars
     2  (request-vars with-request-vars with-request-vars*
     3
     4   ;; Parameters
     5   true-boolean-values
     6
     7   ;; Converters
     8   as-boolean as-list as-number
     9   )
    210
    311(import chicken scheme extras ports files data-structures)
    4 (use intarweb uri-common spiffy)
     12(use srfi-1 srfi-13 intarweb uri-common spiffy)
    513
     14(define true-boolean-values
     15  ;; A list of strings to be considered `#t' for request variables
     16  ;; when `as-boolean' is used as converter.
     17  (make-parameter
     18   '("y" "yes" "1" "on")))
     19
     20(define (req-vars/vals var vars/vals)
     21  (and vars/vals
     22       (let loop ((vars/vals vars/vals))
     23         (if (null? vars/vals)
     24             '()
     25             (let ((var/val (car vars/vals)))
     26               (if (eq? var (car var/val))
     27                   (cons (cdr var/val) (loop (cdr vars/vals)))
     28                   (loop (cdr vars/vals))))))))
     29
     30(define (as-boolean var vals)
     31  (and-let* ((val (alist-ref var vals)))
     32    (not (not (member val (true-boolean-values) string-ci=?)))))
     33
     34(define (as-list var vals)
     35  (let ((vals (req-vars/vals var vals)))
     36    (if (null? vals)
     37        #f
     38        vals)))
     39
     40(define (as-number var vals)
     41  (and-let* ((val (alist-ref var vals)))
     42    (string->number val)))
     43 
    644(define (request-vars #!key (source 'both) max-content-length)
     45   
    746  (let* ((content-matters? (not (memq (request-method (current-request)) '(GET HEAD))))
    847         (get-vars (and (memq source '(both query-string))
     
    2362                     (else body)))))))
    2463
    25     (lambda (var #!optional default (converter identity))
     64    (lambda (var #!optional default/converter)
    2665      (let* ((var (if (string? var)
    2766                      (string->symbol var)
    2867                      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)))))
     68             (vals (or get-vars request-body)))
    3469
    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* (($ %)
    44             (var1 ($ (quote var1)))
    45             ...)
    46        e1 ...))))
     70        (if (procedure? default/converter)
     71            (default/converter var vals)
     72            (let ((vals (req-vars/vals var vals)))
     73              (if (null? vals)
     74                  default/converter
     75                  (car vals))))))))
    4776
    4877(define-syntax with-request-vars*
    4978  (syntax-rules ()
    50     ((_ % (var1 ...) e1 ...)
    51      (let* (($ %)
    52             (var1 ($ (quote var1)))
    53             ...)
    54        e1 ...))))
     79    ((_ $ () form . forms)
     80     (begin form . forms))
     81   
     82    ((_ $ ((var converter) . more-bindings) forms ...)
     83     (let* ((var ($ (quote var) converter)))
     84       (with-request-vars* $ more-bindings forms ...)))
     85   
     86    ((_ $ (var . more-bindings) forms ...)
     87      (let* ((var ($ (quote var))))
     88        (with-request-vars* $ more-bindings forms ...)))))
     89
     90(define-syntax with-request-vars
     91   (syntax-rules ()
     92     ((_ bindings forms ...)
     93      (with-request-vars* (request-vars) bindings forms ...))
     94     ((_ $ bindings forms ...)
     95      (with-request-vars* $ bindings forms ...))))
    5596
    5697) ; end module
Note: See TracChangeset for help on using the changeset viewer.