Changeset 17998 in project


Ignore:
Timestamp:
05/05/10 16:27:04 (9 years ago)
Author:
Moritz Heidkamp
Message:

use spiffy's own send-request now

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/spiffy-uri-match/trunk/spiffy-uri-match.scm

    r16925 r17998  
    77
    88(define (redirect-to path #!key (headers '()))
    9   (response status: 302
    10             headers: (append `((location ,(update-uri (request-uri (current-request))
     9  (response code: 302
     10            headers: (append `((connection close)
     11                               (location ,(update-uri (request-uri (current-request))
    1112                                                      path: path))) headers)))
    12 
    13 (define (send-response #!key (status 200) body (headers '()))
    14   (with-headers (if body `((content-length ,(string-length body))) '())
    15     (lambda ()
    16       (with-headers headers
    17         (lambda ()
    18           (parameterize ((current-response (update-response (current-response) code: status)))
    19             (write-logged-response)
    20             (and body (display body (response-port (current-response))))))))))
    2113
    2214(define (uri-match/spiffy routes)
     
    2517
    2618      (let ((page (match (request-method (current-request))
    27                         (request-uri (current-request)))))
     19                    (request-uri (current-request)))))
    2820       
    2921        (if page (parameterize ((current-response
    3022                                 (update-response (current-response)
    31                                                   code: 200
    32                                                   reason: "OK"
    3323                                                  headers: (headers `((content-type #(text/html ((charset . "utf-8"))))
    3424                                                                      (accept-charset utf-8))
    3525                                                                    (response-headers (current-response))))))
    3626
    37                    (or (let ((args (page))) (and args (apply send-response args)))
    38                        (continue)))
     27                   (let ((args (page)))
     28                     (if args
     29                         (apply send-response args)
     30                         (continue))))
     31
    3932            (continue))))))
    4033
Note: See TracChangeset for help on using the changeset viewer.