;; 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 (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))

(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))

(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-class <session> ()
;;   (dbtype       ;; 'pg or 'sqlite3
;;    dbinit
;;    conn
;;    params       ;; params from the key=val&key1=val2 string
;;    path-params  ;; remaining params from the path
;;    session-key
;;    session-id
(define (session:set-shared! vec varname val)
;;    domain
;;    toppage      ;; defaults to "index" - override in .stml.config if desired
;;    page         ;; the page name - defaults to home
;;    curr-page    ;; the current page being evaluated
  (hash-table-set! (vector-ref vec 33) varname val))

;;    content-type ;; the default content type is text/html, override to deliver other stuff
;;    page-type    ;; use in conjunction with content-type to deliver other payloads
;;    sroot
;;    twikidir     ;; location for twikis - needs to be fully writable by web server
;;    pagedat
;;    alt-page-dat
;;    pagevars     ;; session vars specific to this page
;;    pagevars-before
;;    sessionvars  ;; session vars visible to all pages
;;    sessionvars-before
;; The global session
;;    globalvars   ;; global vars visible to all sessions
;;    globalvars-before
;;    logpt
;;    formdat
(define s:session (make-sdat))
;;    request-method
;;    session-cookie
;;    curr-err
;;    log-port
;;    logfile
;;    seen-pages
;;    page-dir-style  ;; #t = new style, #f = old style
;;    debugmode))

;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT
(define (session:initialize self)
  (sdat-set-dbtype! self      'pg)
  (sdat-set-page! self        "home")        ;; these are defaults
  (sdat-set-curr-page! self   "home")
  (sdat-set-content-type! self "Content-type: text/html; charset=iso-8859-1\n\n")

    (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))
	(dbinit    (eval (sdat-get-dbinit self)))
	(dbexists  #f))
    (let ((dbfname (alist-ref 'dbname dbinit)))
      (if debugmode (session:log self "session:setup dbfname=" dbfname ", dbtype=" dbtype ", dbinit=" dbinit))
      (if (eq? dbtype 'sqlite3)
	  ;; The 'auto method will distribute dbs across the disk using hash
	  ;; of user host and user. TODO
	  ;; (if (eq? dbfname 'auto) ;; This is the auto assignment of a db based on hash of IP
	  (let ((dbpath (pathname-directory dbfname)))  ;; do a couple sanity checks here to make setting up easier
	    (if debugmode (session:log self "INFO: setting up for sqlite3 db access to " dbfname))
	    (if (not (file-write-access? dbpath))
		(session:log self "WARNING: Cannot write to " dbpath)
		(if debugmode (session:log self "INFO: " dbpath " is writeable")))
	    (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

(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)))
    (hash-table-ref/default ht (s:any->string key) #f)))

;; delete a session var for a specified page
;;
(define (session:del! self page key)
  (let ((ht (session:get-page-hash self page)))
    (hash-table-delete! ht key)))
    (hash-table-delete! ht (s:any->string key))))

;; get ALL keys for this page and store in the session pagevars hash
;;
(define (session:get-vars self)
  (let ((session-id  (sdat-get-session-id self)))
    (if (not session-id)
	(err:log "ERROR: No session id in session object! session:get-vars")

       (cond
	((list? x) x)
	((string? x) x)
	(else '())))
     (port-map (lambda (s)
		 (eval s e))
	       (lambda ()(read p))))))

(define (session:process-file f)
  (let* ((p    (open-input-file f))
	 (dat  (process-port p)))
    (close-input-port p)
    dat))

;; May 2011, putting all pages into one directory for the following reasons:
;;   1. want filename to reflect page name (emacs limitation)
;;   2. that's it! no other reason. could make it configurable ...
;; page-dir-style is:
;;  'stored   => stored in executable
;;  'flat     => pages flat directory
;;  'dir      => directory tree pages/<pagename>/{view,control}.scm
;; parts:
;;  'both     => load control and view (anything other than view or control
;;  'view     => load view only
;;  'control  => load control only
(define (session:call-parts self page parts)
(define (session:call-parts self page #!key (parts 'both))
  (sdat-set-curr-page! self page)
  ;; (session:log self "page-dir-style: " (sdat-get-page-dir-style self))
  (let* ((dir-style ;; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
  (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
	  (sdat-get-page-dir-style self))
	 (dir     (string-append (sdat-get-sroot self) 
				 (if dir-style 
				     (conc "/pages/")
				     (conc "/pages/" page))))
	 (control (string-append dir (if dir-style 
	 (dir          (string-append (sdat-get-sroot self) 
				      (if dir-style 
					  (conc "/pages/")
					  (conc "/pages/" page)))))
    (case dir-style
					 (conc page "_ctrl.scm")
					 "/control.scm")))
	 (view    (string-append dir (if dir-style 
					 (conc page "_view.scm")
					 "/view.scm")))
	 (load-view    (and (file-exists? view)
      ;; 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)   
       (let* ((so-file  (conc dir page ".so"))
	      (scm-file (conc dir page ".scm"))
	      (src-file (or (file-exists? so-file)
			    (or (eq? parts 'both)(eq? parts 'view))))
	 (load-control (and (file-exists? control)
			    (file-exists? scm-file))))
			    (or (eq? parts 'both)(eq? parts 'control))))
	 (view-dat   '()))
    ;; (session:log self "dir-style: " dir-style)
 ;;   (sugar "/home/matt/kiatoa/stml/sugar.scm" ))
    ;; (print "dir=" dir " control=" control " view=" view " load-view=" load-view " load=control=" load-control)
    (if load-control
	(begin
	  (load control)
	 (if src-file
	     (begin
	       (load src-file)
	  (session:set-called! self page)))
    ;; move this to where it gets exectuted only once
    ;;
    ;;(s:log "s:b yields " (s:b "blah"))
    (if load-view
	;; option one:
	;;
	;; (let ((inp (open-input-string 
	;; 	    (files-read->string "/home/matt/kiatoa/stml/sugar.scm" 
	;; 				view))))
	;;   (map 
	;;    (lambda (x)
	;;      (cond
	;;       ((list? x) x)
	;;       ((string? x) x)
	;;       (else '())))
	;;    (port-map eval (lambda ()
	       ((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
		))
	     (list "<p>Page not found " page " </p>"))))
       ;; 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))
	;; 		 (read inp)))))
	;;
	;; option two:
	;;
	(let* (;; (inps (map open-input-file (list view))) ;; sugar view)))
	       (p    (open-input-file view)) ;; (apply make-concatenated-port inps))
	       (dat  (process-port p)))
       ;;  	 (session:process-file view-file))
		;;(map 
		;;      (lambda (x)
		;;	(cond
		;;	 ((list? x) x)
		;;	 ((string? x) x)
		;;	 (else '())))
		;;      (port-map eval (lambda ()(read p))))))
	  ;; (map close-input-port inps)
	  (close-input-port p)
	  dat)
	(list "<p>Page not found " page " </p>"))))

;;(define (session:call self page)
       ;;       (list "<p>Page not found " page " </p>")))
      ((dir) "ERROR:  dir style not yet re-implemented")
      (else
;;  (session:call-parts self page 'both))
       (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)
  (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
    (if (file-exists? model.so)
	(load model.so)
	(if (file-exists? model.scm)
	    (load model.scm)
	    (s:log "ERROR: model " model.scm " not found")))))
;; (define (session:load-model self model)
;;   (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm"))
;; 	(model.so  (string-append (sdat-get-sroot self) "/models/" model ".so")))
;;     (if (file-exists? model.so)
;; 	(load model.so)
;; 	(if (file-exists? model.scm)
;; 	    (load model.scm)
;; 	    (s:log "ERROR: model " model.scm " not found")))))

(define (session:model-path self model)
  (string-append (sdat-get-sroot self) "/models/" model ".scm"))
;; (define (session:model-path self model)
;;   (string-append (sdat-get-sroot self) "/models/" model ".scm"))

(define (session:pp-formdat self)
  (let ((dat (formdat:all->strings (sdat-get-formdat self))))
    (string-intersperse dat "<br> ")))

(define (session:param->string params)
  ;; (err:log "params=" params)

	(if (or (string? key)(number? key)(symbol? key))
	    (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)))))

;; This one will get the first value found regardless of form
(define (session:get-input-keys self)
  (let* ((formdat (sdat-get-formdat self)))
    (if (not formdat) #f
	(if (and (vector? formdat)(eq? (vector-length formdat) 1)(hash-table? (vector-ref formdat 0)))
	    (formdat:keys formdat)
	    (begin
	      (session:log self "ERROR: formdat: " formdat " is not of class <formdat>")
	      #f)))))

(define (session:run-actions self)
  (let* ((action    (session:get-param self 'action))
	 (page      (sdat-get-page self)))
    ;; (print "action=" action " page=" page)
    (if action
	(let ((action-lst  (string-split action ".")))