1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
-
+
|
;; Copyright 2007-2011, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(declare (unit session))
(require-library dbi)
(use regex)
(require-extension regex)
(declare (uses cookie))
;; sessions table
;; id session_id session_key
;; create table sessions (id serial not null,session-key text);
;; session_vars table
|
| ︙ | | |
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
+
-
-
-
-
-
+
+
+
+
+
+
|
(let* ((rawconfigdat (session:read-config self))
(configdat (if rawconfigdat (eval rawconfigdat) '()))
(sroot (s:find-param 'sroot configdat))
(logfile (s:find-param 'logfile configdat))
(dbtype (s:find-param 'dbtype configdat))
(dbinit (s:find-param 'dbinit configdat))
(domain (s:find-param 'domain configdat))
(twikidir (s:find-param 'twikidir configdat))
(page-dir (s:find-param 'page-dir-style configdat)))
(if sroot (sdat-set-sroot! self sroot))
(if logfile (sdat-set-logfile! self logfile))
(if dbtype (sdat-set-dbtype! self dbtype))
(if dbinit (sdat-set-dbinit! self dbinit))
(if domain (sdat-set-domain! self domain))
(if sroot (sdat-set-sroot! self sroot))
(if logfile (sdat-set-logfile! self logfile))
(if dbtype (sdat-set-dbtype! self dbtype))
(if dbinit (sdat-set-dbinit! self dbinit))
(if domain (sdat-set-domain! self domain))
(if twikidir (sdat-set-twikidir! self twikidir))
(sdat-set-page-dir-style! self page-dir)
;; (print "configdat: ")(pp configdat)
;;(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype
;; " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir)
)
)
;; (let ((dbtype (sdat-get-dbtype self)))
|
| ︙ | | |
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
|
-
+
-
+
-
+
|
;; session vars
;; 1. keys are always a string NOT a symbol
;; 2. values are always a string conversion is the responsibility of the
;; consuming function (at least for now, I'd like to change this)
;; set a session var for the current page
;;
(define (session:set! self key value)
(define (session:curr-page-set! self key value)
(hash-table-set! (sdat-get-pagevars self) (s:any->string key) (s:any->string value)))
;; del a var for the current page
;;
(define (session:del! self key)
(define (session:page-var-del! self key)
(hash-table-delete! (sdat-get-pagevars self) (s:any->string key)))
;; get the appropriate hash given a page "*sessionvars*, *globalvars* or page
;;
(define (session:get-page-hash self page)
(if (string=? page "*sessionvars*")
(sdat-get-sessionvars self)
(if (string=? page "*globalvars*")
(sdat-get-globalvars self)
(sdat-get-pagevars self))))
;; set a session var for a given page
;;
(define (session:set! self page key value)
(let ((ht (session:get-page-hash self page)))
(hash-table-set! ht (s:any->string key) (s:any->string value))))
;; get session vars for the current page
;;
(define (session:get self key)
(define (session:page-get self key)
(hash-table-ref/default (sdat-get-pagevars self) key #f))
;; get session vars for a specified page
;;
(define (session:get self page key)
(let ((ht (session:get-page-hash self page)))
(hash-table-ref/default ht key #f)))
|
| ︙ | | |
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
|
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
|
-
+
|
(session:get-param-from params key)))
;; This one will get the first value found regardless of form
(define (session:get-input self key)
(let* ((formdat (sdat-get-formdat self)))
(if (not formdat) #f
(if (or (string? key)(number? key)(symbol? key))
(if (eq? (class-of formdat) <formdat>)
(if (and (vector? formdat)(eq? (vector-length formdat) 1)(hash-table? (vector-ref formdat 0)))
(formdat:get formdat key)
(begin
(session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
#f))
(session:log self "ERROR: bad key " key)))))
(define (session:run-actions self)
|
| ︙ | | |