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
|
;; 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
(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-method (initialize (self <sqltbl>) 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 <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
(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)
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))
(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)
actual-query)
(slot-set! self 'query-params params)
(slot-set! self 'num-rows (length result))
(sqltbl:setup-fields self) ;; update the fields lookup hash
(reverse result))))
(slot-set! self 'rows rows)
(if (not (null? rows))
(slot-set! self 'curr-row (car rows)))
(slot-set! self 'curr-row-ptr 0)
rows))
(define-method (sqltbl:setup-fields (self <sqltbl>))
(let ((fields-hash (slot-ref self 'fields-hash))
(fields-list (slot-ref self 'fields)))
(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)))
(if field-num
(vector-ref curr-row field-num)
#f))) ;; not found -> #f
(define-method (sqltbl:vector->hash (self <sqltbl>) vec)
(let ((h (make-hash-table))
(fields (slot-ref self 'fields)))
(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)
(map (lambda (row)
(proc (sqltbl:vector->hash self row))) (slot-ref self 'rows)))
|
<
<
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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
|
;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
;;
;; DON'T USE THIS!!!! It was a bad idea :-(
;; (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 (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)))
(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 (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)))
(sqltbl:tbl-get-conn self)
actual-query)
(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))))
(sqltbl:tbl-set-rows! self rows)
(if (not (null? rows))
(sqltbl:tbl-set-curr-row! self (car rows)))
(sqltbl:tbl-set-curr-row-ptr! self 0)
rows))
(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 (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 (sqltbl:vector->hash self vec)
(let ((h (make-hash-table))
(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 (sqltbl:map self proc)
(map (lambda (row)
(proc (sqltbl:vector->hash self row))) (sqltbl:tbl-get-rows self)))
|