Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -20,11 +20,11 @@ all : $(SOFILES) stmlrun : stmlrun.scm formdat.scm misc-stml.scm session.scm stml.scm \ setup.scm html-filter.scm requirements.scm keystore.scm \ - cookie.scm + cookie.scm sqltbl.scm csc stmlrun.scm $(TARGDIR)/stmlrun : stmlrun cp stmlrun $(TARGDIR) Index: session.scm ================================================================== --- session.scm +++ session.scm @@ -125,11 +125,11 @@ ;; seen-pages ;; page-dir-style ;; #t = new style, #f = old style ;; debugmode)) ;; SPLIT INTO STRAIGHT FORWARD INIT AND COMPLEX INIT -(define (initialize self) +(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") (sdat-set-page-type! self 'html) @@ -305,11 +305,11 @@ "COMMIT;")) (conn (sdat-get-conn self))) (if session-id (begin (dbi:exec conn qry session-id session-id) - (initialize self '()) + (session:initialize self) (session:setup self))) (not (session:get-session-id self session-key)))) ;; (define (session:delete-session self session-key) ;; (let ((session-id (session:get-session-id self session-key)) Index: setup.scm ================================================================== --- setup.scm +++ setup.scm @@ -7,11 +7,11 @@ ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;; (define s:session (make-sdat)) -(initialize s:session) +(session:initialize s:session) ;; use this for getting data from page to page when scope and evals ;; get in the way (define s:local-vars (make-hash-table)) Index: sqltbl.scm ================================================================== --- sqltbl.scm +++ sqltbl.scm @@ -1,94 +1,111 @@ ;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved. ;; ;; DON'T USE THIS!!!! It was a bad idea :-( -;; If performance becomes an issue upgrade this to use a vector to - -(require-extension tinyclos) - -(define-class () - (rows - fields ;; list of field - fields-hash ;; hash of fields -> number - query ;; query string using ?'s - query-params ;; list of params for the query - conn ;; connection to db - num-rows ;; whatever - curr-row-ptr ;; number of the current row - curr-row ;; the current row vector (?? do we really want this ??) - )) - -(define-method (initialize (self ) initargs) - (call-next-method) - (slot-set! self 'num-rows 0) - (slot-set! self 'curr-row-ptr 0) - (slot-set! self 'fields '()) - (slot-set! self 'fields-hash (make-hash-table)) - (initialize-slots self initargs)) -;; (if (> (length (slot-ref self 'rows) 0)) -;; (slot-set! self 'curr-row (car rows)))) - -(define-method (sqltbl:next-row (self )) - (let ((curr-row-ptr (+ (slot-ref self 'curr-row-ptr) 1)) - (num-rows (slot-ref self 'num-rows)) - (rows (slot-ref self 'rows))) - (if (> curr-row-prt (slot-ref self 'num-rows)) #f ;; there is no next row +;; (require-extension tinyclos) + +;; (define-class () +;; (rows +;; fields ;; list of field +;; fields-hash ;; hash of fields -> number +;; query ;; query string using ?'s +;; query-params ;; list of params for the query +;; conn ;; connection to db +;; num-rows ;; whatever +;; curr-row-ptr ;; number of the current row +;; curr-row ;; the current row vector (?? do we really want this ??) +;; )) + +(define (make-sqltbl:tbl)(make-vector 9)) +(define-inline (sqltbl:tbl-get-rows vec) (vector-ref vec 0)) +(define-inline (sqltbl:tbl-get-fields vec) (vector-ref vec 1)) +(define-inline (sqltbl:tbl-get-fields-hash vec) (vector-ref vec 2)) +(define-inline (sqltbl:tbl-get-query vec) (vector-ref vec 3)) +(define-inline (sqltbl:tbl-get-query-params vec) (vector-ref vec 4)) +(define-inline (sqltbl:tbl-get-conn vec) (vector-ref vec 5)) +(define-inline (sqltbl:tbl-get-num-rows vec) (vector-ref vec 6)) +(define-inline (sqltbl:tbl-get-curr-row-ptr vec) (vector-ref vec 7)) +(define-inline (sqltbl:tbl-get-curr-row vec) (vector-ref vec 8)) +(define-inline (sqltbl:tbl-set-rows! vec val)(vector-set! vec 0 val)) +(define-inline (sqltbl:tbl-set-fields! vec val)(vector-set! vec 1 val)) +(define-inline (sqltbl:tbl-set-fields-hash! vec val)(vector-set! vec 2 val)) +(define-inline (sqltbl:tbl-set-query! vec val)(vector-set! vec 3 val)) +(define-inline (sqltbl:tbl-set-query-params! vec val)(vector-set! vec 4 val)) +(define-inline (sqltbl:tbl-set-conn! vec val)(vector-set! vec 5 val)) +(define-inline (sqltbl:tbl-set-num-rows! vec val)(vector-set! vec 6 val)) +(define-inline (sqltbl:tbl-set-curr-row-ptr! vec val)(vector-set! vec 7 val)) +(define-inline (sqltbl:tbl-set-curr-row! vec val)(vector-set! vec 8 val)) + +(define (session:initialize self);; initargs) + (sqltbl:tbl-set-num-rows! self 0) + (sqltbl:tbl-set-curr-row-ptr! self 0) + (sqltbl:tbl-set-fields! self '()) + (sqltbl:tbl-set-fields-hash! self (make-hash-table))) + ;; (initialize-slots self initargs)) +;; (if (> (length (sqltbl:tbl-get-rows self) 0)) +;; (sqltbl:tbl-set-curr-row! self (car rows)))) + +(define (sqltbl:next-row self) + (let ((curr-row-ptr (+ (sqltbl:tbl-get-curr-row-ptr self) 1)) + (num-rows (sqltbl:tbl-get-num-rows self)) + (rows (sqltbl:tbl-get-rows self))) + (if (> curr-row-prt (sqltbl:tbl-get-num-rows self)) #f ;; there is no next row (let ((new-curr-row (list-ref rows curr-row-ptr))) - (slot-set! self 'curr-row new-curr-row) - (slot-set! self 'curr-row-prt curr-row-prt) + (sqltbl:tbl-set-curr-row! self new-curr-row) + (sqltbl:tbl-set-curr-row-prt! self curr-row-prt) new-curr-row)))) ;; run the query and fill the rows list -(define-method (sqltbl:run-query (self ) . params) - (let* ((query (slot-ref self 'query)) - (fields (slot-ref self 'fields)) +(define (sqltbl:run-query self . params) + (let* ((query (sqltbl:tbl-get-query self)) + (fields (sqltbl:tbl-get-fields self)) (rows (let ((result '()) (actual-query (apply s:sqlparam query fields params))) ;; (s:log "actual-query=" actual-query) (dbi:for-each-row (lambda (tuple) (set! result (cons tuple result))) - (slot-ref self 'conn) + (sqltbl:tbl-get-conn self) actual-query) - (slot-set! self 'query-params params) - (slot-set! self 'num-rows (length result)) + (sqltbl:tbl-set-query-params! self params) + (sqltbl:tbl-set-num-rows! self (length result)) (sqltbl:setup-fields self) ;; update the fields lookup hash (reverse result)))) - (slot-set! self 'rows rows) + (sqltbl:tbl-set-rows! self rows) (if (not (null? rows)) - (slot-set! self 'curr-row (car rows))) - (slot-set! self 'curr-row-ptr 0) + (sqltbl:tbl-set-curr-row! self (car rows))) + (sqltbl:tbl-set-curr-row-ptr! self 0) rows)) -(define-method (sqltbl:setup-fields (self )) - (let ((fields-hash (slot-ref self 'fields-hash)) - (fields-list (slot-ref self 'fields))) +(define (sqltbl:setup-fields self) + (let ((fields-hash (sqltbl:tbl-get-fields-hash self)) + (fields-list (sqltbl:tbl-get-fields self))) (let loop ((head (car fields-list)) (tail (cdr fields-list)) (fnum 0)) (hash-table-set! fields-hash head fnum) (if (null? tail) fnum (loop (car tail)(cdr tail)(+ fnum 1)))))) ;; get a value from the current row -(define-method (sqltbl:get-field-value-curr (self ) field) - (let ((curr-row (slot-ref self 'curr-row)) - (field-num (hash-table-ref/default (slot-ref self 'fields-hash) field #f))) +(define (sqltbl:get-field-value-curr self field) + (let ((curr-row (sqltbl:tbl-get-curr-row self)) + (field-num (hash-table-ref/default (sqltbl:tbl-get-fields-hash self) field #f))) (if field-num (vector-ref curr-row field-num) #f))) ;; not found -> #f -(define-method (sqltbl:vector->hash (self ) vec) +(define (sqltbl:vector->hash self vec) (let ((h (make-hash-table)) - (fields (slot-ref self 'fields))) + (fields (sqltbl:tbl-get-fields self))) (do ((i 0 (+ i 1))) ((>= i (length fields))) (hash-table-set! h (list-ref fields i)(vector-ref vec i))) h)) ;; runs proc on each row and returns the resulting list -(define-method (sqltbl:map (self ) proc) +(define (sqltbl:map self proc) (map (lambda (row) - (proc (sqltbl:vector->hash self row))) (slot-ref self 'rows))) + (proc (sqltbl:vector->hash self row))) (sqltbl:tbl-get-rows self))) Index: stmlrun.scm ================================================================== --- stmlrun.scm +++ stmlrun.scm @@ -35,15 +35,15 @@ (s:validate-inputs) (session:run-actions s:session) -(slot-set! s:session 'pagedat - (append (slot-ref s:session 'pagedat) - (s:call (slot-ref s:session 'toppage)))) +(sdat-set-pagedat! s:session + (append (sdat-get-pagedat s:session) + (s:call (sdat-get-toppage s:session)))) -(if (eq? (slot-ref s:session 'page-type) 'html) ;; default is html. +(if (eq? (sdat-get-page-type s:session) 'html) ;; default is html. (session:cgi-out s:session) (session:alt-out s:session)) (session:save-vars s:session)