Differences From Artifact [b05f4ba4b6]:

To Artifact [29093c83c7]:


1

2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20

































21
22

23
24
25
26
27
28
29
30







31
32
33
34
35
36





37
38
39


40
41
42
43
44
45



46
47
48
49
50
51

52
53
54


55
56
57

58
59
60


61
62
63
64
65



66
67
68
69
70
71
72
73
74
75
76



77
78
79
80
81

82
83

84
85
86
87
88
89
90
91

92
93

94

1
2
3
4
5



6
7











8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

42








43
44
45
46
47
48
49
50





51
52
53
54
55
56


57
58
59
60
61



62
63
64
65
66
67
68
69

70
71


72
73
74
75

76
77


78
79
80
81



82
83
84
85
86
87
88
89
90
91
92



93
94
95
96
97
98
99

100
101

102
103
104
105
106
107
108
109

110
111

112
113
-
+




-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+



-
-
-
+
+
+





-
+

-
-
+
+


-
+

-
-
+
+


-
-
-
+
+
+








-
-
-
+
+
+




-
+

-
+







-
+

-
+

;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
;; Copyright 2007-2011, 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)
;; (require-extension tinyclos)

(define-class <sqltbl> ()
  (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-class <sqltbl> ()
;;   (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 ??)
;;    ))

(declare (unit sqltbl))

(define (make-sqltbl:tbl)(make-vector 9))
(define (sqltbl:tbl-get-rows           vec)    (vector-ref  vec 0))
(define (sqltbl:tbl-get-fields         vec)    (vector-ref  vec 1))
(define (sqltbl:tbl-get-fields-hash    vec)    (vector-ref  vec 2))
(define (sqltbl:tbl-get-query          vec)    (vector-ref  vec 3))
(define (sqltbl:tbl-get-query-params   vec)    (vector-ref  vec 4))
(define (sqltbl:tbl-get-conn           vec)    (vector-ref  vec 5))
(define (sqltbl:tbl-get-num-rows       vec)    (vector-ref  vec 6))
(define (sqltbl:tbl-get-curr-row-ptr   vec)    (vector-ref  vec 7))
(define (sqltbl:tbl-get-curr-row       vec)    (vector-ref  vec 8))
(define (sqltbl:tbl-set-rows!          vec val)(vector-set! vec 0 val))
(define (sqltbl:tbl-set-fields!        vec val)(vector-set! vec 1 val))
(define (sqltbl:tbl-set-fields-hash!   vec val)(vector-set! vec 2 val))
(define (sqltbl:tbl-set-query!         vec val)(vector-set! vec 3 val))
(define (sqltbl:tbl-set-query-params!  vec val)(vector-set! vec 4 val))
(define (sqltbl:tbl-set-conn!          vec val)(vector-set! vec 5 val))
(define (sqltbl:tbl-set-num-rows!      vec val)(vector-set! vec 6 val))
(define (sqltbl:tbl-set-curr-row-ptr!  vec val)(vector-set! vec 7 val))
(define (sqltbl:tbl-set-curr-row!      vec val)(vector-set! vec 8 val))

(define-method (initialize (self <sqltbl>) initargs)
(define  (sqltbl: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))))
  (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-method (sqltbl:next-row (self <sqltbl>))
  (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
(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 <sqltbl>) . 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 <sqltbl>))
  (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 <sqltbl>) 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 <sqltbl>) 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 <sqltbl>) 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)))