vegashacker / leftparen
watch download tarball
public
Forks8Right
Watchers18Right
Description: An easy way to make web apps (in PLT Scheme)
Homepage: http://blog.leftparen.com
Clone URL: git://github.com/vegashacker/leftparen.git
Click here to lend your support to: leftparen and make a donation at www.pledgie.com !
leftparen / closures.scm
raw normal view history
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 1 #lang scheme/base
2
3 (require (file "util.scm")
af0a5496 » vegashacker 2009-01-08 added web-export for conven... 4 "web-export.ss"
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 5 (file "web-support.scm")
6 (file "settings.scm"))
7
8 (provide add-closure!
9 call-closure
10 closure-key->url
11 make-closure-key
12 body-as-closure-key
13 body-as-url
14 handle-closure-in-req
15 num-closures-in-memory
16 )
17
2a332f6d » vegashacker 2009-05-13 allow for optional sticky c... 18 (define-syntax body-as-closure-key-aux
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 19 (syntax-rules ()
2a332f6d » vegashacker 2009-05-13 allow for optional sticky c... 20 ((_ req-iden key-iden is-sticky-expr body ...)
21 (let ((is-sticky is-sticky-expr))
22 (add-closure! #:key key-iden
23 (lambda (req-iden)
24 ;; first cleanup after itself (if not sticky)
25 (unless is-sticky (hash-remove! CLOSURES key-iden))
811ac6b9 » vegashacker 2009-04-24 closures now automatically ... 26 ;; then run the actual closure...
27 body ...))))))
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 28
2a332f6d » vegashacker 2009-05-13 allow for optional sticky c... 29 (define-syntax body-as-closure-key
30 (syntax-rules ()
31 ((_ (req-iden #:sticky) body ...)
32 (let ((key-iden (make-closure-key)))
33 (body-as-closure-key-aux req-iden key-iden #t body ...)))
34 ((_ (req-iden key-expr #:sticky) body ...)
35 (let ((key-iden key-expr))
36 (body-as-closure-key-aux req-iden key-iden #t body ...)))
37 ((_ (req-iden) body ...)
38 (let ((key-iden (make-closure-key)))
39 (body-as-closure-key-aux req-iden key-iden #f body ...)))
40 ((_ (req-iden key-expr) body ...)
41 (let ((key-iden key-expr))
42 (let ((key-iden key-expr))
43 (body-as-closure-key-aux req-iden key-iden #f body ...))))))
44
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 45 ;;
46 ;; body-as-url
47 ;;
2a332f6d » vegashacker 2009-05-13 allow for optional sticky c... 48 ;; Forms:
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 49 ;; (body-as-url (req) body ...)
50 ;; (body-as-url (req fn-key) body ...)
2a332f6d » vegashacker 2009-05-13 allow for optional sticky c... 51 ;; (body-as-url (req #:sticky) body ...)
52 ;; (body-as-url (req fn-key #:sticky) body ...)
53 ;;
54 ;; If fn-key is given, it will be the key used to map to the body.
55 ;; (This provides a way for the developer to reuse fns in certain situations.)
56 ;;
57 ;; If #:sticky appears at the end of the first argument, then the closure will not
58 ;; be removed form memory after it's invoked (on a server restart, however, all closures
59 ;; --regardless of stickiness--are cleared).
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 60 ;;
61 (define-syntax body-as-url
62 (syntax-rules ()
126f8489 » vegashacker 2009-05-15 added some documentation on... 63 ((_ (spec ...) body ...)
64 (closure-key->url (body-as-closure-key (spec ...) body ...)))))
f8a6c87f » vegashacker 2008-09-25 importing the current leftp... 65
66 (define (closure-key->url clos-key)
67 (format "~A?~A=~A"
68 (setting *WEB_APP_URL*)
69 (setting *CLOSURE_URL_KEY*)
70 clos-key))
71
72 (define-syntax handle-closure-in-req
73 (syntax-rules ()
74 ((_ req no-closure-body ...)
75 (let ((url-key (setting *CLOSURE_URL_KEY*))
76 (binds (request-bindings req)))
77 (if (exists-binding? url-key binds)
78 (call-closure (extract-binding/single url-key binds) req)
79 (begin no-closure-body ...))))))
80
81 (define CLOSURES (make-hash))
82
83 (define (make-closure-key)
84 (random-key-string 20))
85
86 ;; returns the key
87 (define (add-closure! clos #:key (key #f))
88 (let ((key (or key (make-closure-key))))
89 (hash-set! CLOSURES key clos)
90 key))
91
92 (define (call-closure key req)
93 ((hash-ref CLOSURES key (lambda ()
94 (lambda (req)
95 (format "Expired or missing function '~A'." key))))
96 req))
97
98 (define (num-closures-in-memory)
99 (hash-count CLOSURES))