Index: rollup-pages.scm
==================================================================
--- rollup-pages.scm
+++ rollup-pages.scm
@@ -1,8 +1,16 @@
(use regex posix srfi-69 srfi-1)
(define extract-rx (regexp "pages\\/(.*)_(view|ctrl).scm"))
+
+(define (print-page-wrapper lookup page)
+ (print "(define (pages:" page " session db shared)")
+ (if (hash-table-ref/default lookup (conc page "_ctrl") #f)
+ (print "(include \"pages/" page "_ctrl.scm\")"))
+ (if (hash-table-ref/default lookup (conc page "_view") #f)
+ (print "(include \"pages/" page "_view.scm\")"))
+ (print ")\n"))
(let* ((views (glob "pages/*_view.scm"))
(ctrls (glob "pages/*_ctrl.scm"))
(all (append views ctrls))
(lookup (make-hash-table))
@@ -12,20 +20,30 @@
(page (cadr res))
(type (caddr res)))
(hash-table-set! lookup (conc page "_" type) #t)
(cadr res)))
all))))
- (if (null? all)(begin (print "No page files matching pages/*_(view|ctrl).scm")(exit)))
+ (if (null? all)(begin (print "No page files matching pages/*_(view|ctrl).scm")(exit)))
(print "Pages: " pages)
+ ;; first the individual rollup wrappers (used by the dynamic load)
+ (for-each
+ (lambda (page)
+ (let ((pagefile (conc "pages/" page ".scm")))
+ (print "page " page " ")
+ (if (not (file-exists? pagefile))
+ (begin
+ (with-output-to-file pagefile
+ (lambda ()
+ (print-page-wrapper lookup page)))
+ (print " created"))
+ (print " already created"))))
+ pages)
+ ;; then the monolithic rollup wrapper (used in compiling the single-executable)
(with-output-to-file "all_pages.scm"
(lambda ()
- (for-each (lambda (page)
- (print "(define (pages:" page ")")
- (if (hash-table-ref/default lookup (conc page "_ctrl") #f)
- (print "(include \"pages/" page "_ctrl.scm\")"))
- (if (hash-table-ref/default lookup (conc page "_view") #f)
- (print "(include \"pages/" page "_view.scm\")"))
- (print ")\n"))
- pages))))
+ (for-each
+ (lambda (page)
+ (print-page-wrapper lookup page))
+ pages))))
Index: session.scm
==================================================================
--- session.scm
+++ session.scm
@@ -24,11 +24,11 @@
;; 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 (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))
@@ -59,10 +59,15 @@
(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))
@@ -92,10 +97,14 @@
(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
@@ -148,11 +157,15 @@
;; (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)
@@ -173,10 +186,11 @@
;; (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)
@@ -600,25 +614,36 @@
(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)
+ ((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 "Page not found " page "
"))))
- ((flat))
+ ;; (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 "Page not found " page "
")))
+ ((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))