︙ | | | ︙ | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
;; TODO
;; Concept of order num incremented with each page access
;; if a branch is taken then a new session would need to be created
;;
;; make-vector-record session session dbtype dbinit conn params path-params session-key session-id domain toppage page curr-page content-type page-type sroot twikidir pagedat alt-page-dat pagevars pagevars-before sessionvars sessionvars-before globalvars globalvars-before logpt formdat request-method session-cookie curr-err log-port logfile seen-pages page-dir-style debugmode
(define (make-sdat)(make-vector 33))
(define (sdat-get-dbtype vec) (vector-ref vec 0))
(define (sdat-get-dbinit vec) (vector-ref vec 1))
(define (sdat-get-conn vec) (vector-ref vec 2))
(define (sdat-get-pgconn vec) (vector-ref (vector-ref vec 2) 1))
(define (sdat-get-params vec) (vector-ref vec 3))
(define (sdat-get-path-params vec) (vector-ref vec 4))
(define (sdat-get-session-key vec) (vector-ref vec 5))
|
|
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
;; TODO
;; Concept of order num incremented with each page access
;; if a branch is taken then a new session would need to be created
;;
;; make-vector-record session session dbtype dbinit conn params path-params session-key session-id domain toppage page curr-page content-type page-type sroot twikidir pagedat alt-page-dat pagevars pagevars-before sessionvars sessionvars-before globalvars globalvars-before logpt formdat request-method session-cookie curr-err log-port logfile seen-pages page-dir-style debugmode
(define (make-sdat)(make-vector 34))
(define (sdat-get-dbtype vec) (vector-ref vec 0))
(define (sdat-get-dbinit vec) (vector-ref vec 1))
(define (sdat-get-conn vec) (vector-ref vec 2))
(define (sdat-get-pgconn vec) (vector-ref (vector-ref vec 2) 1))
(define (sdat-get-params vec) (vector-ref vec 3))
(define (sdat-get-path-params vec) (vector-ref vec 4))
(define (sdat-get-session-key vec) (vector-ref vec 5))
|
︙ | | | ︙ | |
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
(define (sdat-get-session-cookie vec) (vector-ref vec 26))
(define (sdat-get-curr-err vec) (vector-ref vec 27))
(define (sdat-get-log-port vec) (vector-ref vec 28))
(define (sdat-get-logfile vec) (vector-ref vec 29))
(define (sdat-get-seen-pages vec) (vector-ref vec 30))
(define (sdat-get-page-dir-style vec) (vector-ref vec 31))
(define (sdat-get-debugmode vec) (vector-ref vec 32))
(define (sdat-set-dbtype! vec val)(vector-set! vec 0 val))
(define (sdat-set-dbinit! vec val)(vector-set! vec 1 val))
(define (sdat-set-conn! vec val)(vector-set! vec 2 val))
(define (sdat-set-params! vec val)(vector-set! vec 3 val))
(define (sdat-set-path-params! vec val)(vector-set! vec 4 val))
(define (sdat-set-session-key! vec val)(vector-set! vec 5 val))
(define (sdat-set-session-id! vec val)(vector-set! vec 6 val))
|
>
>
>
>
>
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
(define (sdat-get-session-cookie vec) (vector-ref vec 26))
(define (sdat-get-curr-err vec) (vector-ref vec 27))
(define (sdat-get-log-port vec) (vector-ref vec 28))
(define (sdat-get-logfile vec) (vector-ref vec 29))
(define (sdat-get-seen-pages vec) (vector-ref vec 30))
(define (sdat-get-page-dir-style vec) (vector-ref vec 31))
(define (sdat-get-debugmode vec) (vector-ref vec 32))
(define (sdat-get-shared-hash vec) (vector-ref vec 33))
(define (session:get-shared vec varname)
(hash-table-ref/default (vector-ref vec 33) varname #f))
(define (sdat-set-dbtype! vec val)(vector-set! vec 0 val))
(define (sdat-set-dbinit! vec val)(vector-set! vec 1 val))
(define (sdat-set-conn! vec val)(vector-set! vec 2 val))
(define (sdat-set-params! vec val)(vector-set! vec 3 val))
(define (sdat-set-path-params! vec val)(vector-set! vec 4 val))
(define (sdat-set-session-key! vec val)(vector-set! vec 5 val))
(define (sdat-set-session-id! vec val)(vector-set! vec 6 val))
|
︙ | | | ︙ | |
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
(define (sdat-set-session-cookie! vec val)(vector-set! vec 26 val))
(define (sdat-set-curr-err! vec val)(vector-set! vec 27 val))
(define (sdat-set-log-port! vec val)(vector-set! vec 28 val))
(define (sdat-set-logfile! vec val)(vector-set! vec 29 val))
(define (sdat-set-seen-pages! vec val)(vector-set! vec 30 val))
(define (sdat-set-page-dir-style! vec val)(vector-set! vec 31 val))
(define (sdat-set-debugmode! vec val)(vector-set! vec 32 val))
;; The global session
(define s:session (make-sdat))
;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT
(define (session:initialize self)
(sdat-set-dbtype! self 'pg)
|
>
>
>
>
|
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
(define (sdat-set-session-cookie! vec val)(vector-set! vec 26 val))
(define (sdat-set-curr-err! vec val)(vector-set! vec 27 val))
(define (sdat-set-log-port! vec val)(vector-set! vec 28 val))
(define (sdat-set-logfile! vec val)(vector-set! vec 29 val))
(define (sdat-set-seen-pages! vec val)(vector-set! vec 30 val))
(define (sdat-set-page-dir-style! vec val)(vector-set! vec 31 val))
(define (sdat-set-debugmode! vec val)(vector-set! vec 32 val))
(define (sdat-set-shared-hash! vec val)(vector-set! vec 33 val))
(define (session:set-shared! vec varname val)
(hash-table-set! (vector-ref vec 33) varname val))
;; The global session
(define s:session (make-sdat))
;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT
(define (session:initialize self)
(sdat-set-dbtype! self 'pg)
|
︙ | | | ︙ | |
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
(if debugmode (sdat-set-debugmode! self debugmode))
(sdat-set-page-dir-style! self page-dir)
;; (print "configdat: ")(pp configdat)
(if debugmode
(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype
" dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
)
)
;; (let ((dbtype (sdat-get-dbtype self)))
;; (print "dbtype: " dbtype)
;; (sdat-set-dbtype! self (eval dbtype))))
(define (session:setup self)
(let ((dbtype (sdat-get-dbtype self))
(debugmode (sdat-get-debugmode self))
|
>
>
>
>
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
(if debugmode (sdat-set-debugmode! self debugmode))
(sdat-set-page-dir-style! self page-dir)
;; (print "configdat: ")(pp configdat)
(if debugmode
(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype
" dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir))
)
(sdat-set-shared-hash! self (make-hash-table))
)
;; Used for the strangely inconsistent handling of the config file. A better way is needed.
;;
;; (let ((dbtype (sdat-get-dbtype self)))
;; (print "dbtype: " dbtype)
;; (sdat-set-dbtype! self (eval dbtype))))
(define (session:setup self)
(let ((dbtype (sdat-get-dbtype self))
(debugmode (sdat-get-debugmode self))
|
︙ | | | ︙ | |
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
(if (file-exists? dbfname)
(begin
;; (session:log self "setting dbexists to #t")
(set! dbexists #t))))
(if debugmode (session:log self "INFO: setting up for pg db access to account info " dbinit)))
(if debugmode (session:log self "dbtype: " dbtype " dbfname: " dbfname " dbexists: " dbexists)))
(sdat-set-conn! self (dbi:open dbtype dbinit))
(if (and (not dbexists)(eq? dbtype 'sqlite3))
(begin
(print "WARNING: Setting up session db with sqlite3")
(session:setup-db self)))
(session:process-url-path self)
(session:setup-session-key self)
;; capture stdin if this is a POST
|
>
|
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
|
(if (file-exists? dbfname)
(begin
;; (session:log self "setting dbexists to #t")
(set! dbexists #t))))
(if debugmode (session:log self "INFO: setting up for pg db access to account info " dbinit)))
(if debugmode (session:log self "dbtype: " dbtype " dbfname: " dbfname " dbexists: " dbexists)))
(sdat-set-conn! self (dbi:open dbtype dbinit))
(set! *db* (sdat-get-conn self))
(if (and (not dbexists)(eq? dbtype 'sqlite3))
(begin
(print "WARNING: Setting up session db with sqlite3")
(session:setup-db self)))
(session:process-url-path self)
(session:setup-session-key self)
;; capture stdin if this is a POST
|
︙ | | | ︙ | |
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
|
(let* ((dir-style (sdat-get-page-dir-style self));; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
(dir (string-append (sdat-get-sroot self)
(if dir-style
(conc "/pages/")
(conc "/pages/" page)))))
(case dir-style
;; NB// Stored always loads both control and view
((stored)((eval (string->symbol (conc "pages:" page)))))
((dir)
;; first the control
(let ((control-file (conc "pages/" page "_ctrl.scm"))
(view-file (conc "pages/" page "_view.scm")))
(if (and (file-exists? control-file)
(not (eq? parts 'view)))
(begin
(session:set-called! self page)
(load control-file)))
(if (file-exists? view-file)
(if (not (eq? parts 'control))
(session:process-file view-file))
(list "<p>Page not found " page " </p>"))))
((flat))
(else
(list "ERROR: page-dir-style must be stored, dir or flat, got " dir-style)))))
(define (session:call self page parts)
(session:call-parts self page 'both))
;; (define (session:load-model self model)
|
>
|
>
>
>
>
|
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
<
>
|
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
|
(let* ((dir-style (sdat-get-page-dir-style self));; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
(dir (string-append (sdat-get-sroot self)
(if dir-style
(conc "/pages/")
(conc "/pages/" page)))))
(case dir-style
;; NB// Stored always loads both control and view
((stored)
((eval (string->symbol (conc "pages:" page)))
self ;; the session
(sdat-get-conn self) ;; the db connection
(sdat-get-shared-hash self) ;; a shared hash table for passing data to/from page calls
))
((flat)
(load (conc dir page ".so"))
((eval (string->symbol (conc "pages:" page)))
self ;; the session
(sdat-get-conn self) ;; the db connection
(sdat-get-shared-hash self) ;; a shared hash table for passing data to/from page calls
))
;; first the control
;; (let ((control-file (conc "pages/" page "_ctrl.scm"))
;; (view-file (conc "pages/" page "_view.scm")))
;; (if (and (file-exists? control-file)
;; (not (eq? parts 'view)))
;; (begin
;; (session:set-called! self page)
;; (load control-file)))
;; (if (file-exists? view-file)
;; (if (not (eq? parts 'control))
;; (session:process-file view-file))
;; (list "<p>Page not found " page " </p>")))
((dir) "ERROR: dir style not yet re-implemented")
(else
(list "ERROR: page-dir-style must be stored, dir or flat, got " dir-style)))))
(define (session:call self page parts)
(session:call-parts self page 'both))
;; (define (session:load-model self model)
|
︙ | | | ︙ | |