15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
(import (prefix sqlite3 sqlite3:))
(declare (uses common))
(declare (uses margs))
(declare (uses keys))
(declare (uses items))
(declare (uses db))
(declare (uses configf))
|
>
>
|
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
|
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct
(import (prefix sqlite3 sqlite3:))
(include "/nfs/site/disks/icf_fdk_cw_gwa002/srehman/fossil/dbi/dbi.scm")
(import (prefix dbi dbi:))
(declare (uses common))
(declare (uses margs))
(declare (uses keys))
(declare (uses items))
(declare (uses db))
(declare (uses configf))
|
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
|
dbstr
(if (equal? (car parts) "sqlite3")
(cadr parts)
(begin
(debug:print 0 *default-log-port* "ERROR: I only know sqlite3 databases for now: " dbstr)
#f)))))
(if (and dbpth (file-read-access? dbpth))
(let ((db (sqlite3:open-database dbpth))) ;; (open-database dbpth)))
(sqlite3:set-busy-handler! db (make-busy-timeout 10000))
db)
#f)))
;; sqlite3:path tablename timefieldname varfieldname field1 field2 ...
;;
(define (dboard:graph-read-data cmdstring tstart tend)
(let* ((parts (string-split cmdstring))) ;; spaces not allowed
|
|
|
|
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
|
dbstr
(if (equal? (car parts) "sqlite3")
(cadr parts)
(begin
(debug:print 0 *default-log-port* "ERROR: I only know sqlite3 databases for now: " dbstr)
#f)))))
(if (and dbpth (file-read-access? dbpth))
(let ((db (dbi:open 'sqlite3 (cons (cons ('dbname dbpth) '()))))) ;; (open-database dbpth)))
;;(sqlite3:set-busy-handler! db (make-busy-timeout 10000))
db)
#f)))
;; sqlite3:path tablename timefieldname varfieldname field1 field2 ...
;;
(define (dboard:graph-read-data cmdstring tstart tend)
(let* ((parts (string-split cmdstring))) ;; spaces not allowed
|
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
|
(begin
(for-each
(lambda (fieldname) ;; fields
(let ((all-dat-qrystr (conc "SELECT " timef "," varfn "," valfn " FROM " tablen " WHERE " varfn "='" fieldname "' AND " timef " >= " tstart " AND " timef " <= " tend " ORDER BY " timef " ASC"))
(zeroth-point (conc "SELECT " timef "," varfn "," valfn " FROM " tablen " WHERE " varfn "='" fieldname "' AND " timef " < " tstart " LIMIT 1")))
(hash-table-set! res-ht fieldname ;; (fetch-rows (sql db qrystr)))))
(reverse
(sqlite3:fold-row
(lambda (res t var val)
(cons (vector t var val) res))
'() db all-dat-qrystr)))
(let ((zeropt (handle-exceptions
exn
#f
(sqlite3:first-row db all-dat-qrystr))))
(if zeropt ;; NOTE: Add zeropt to the beginning of the list as the list was reversed above.
(hash-table-set! res-ht
fieldname
(cons
(apply vector tstart (cdr zeropt))
(hash-table-ref/default res-ht fieldname '())))))))
fields)
|
|
|
|
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
|
(begin
(for-each
(lambda (fieldname) ;; fields
(let ((all-dat-qrystr (conc "SELECT " timef "," varfn "," valfn " FROM " tablen " WHERE " varfn "='" fieldname "' AND " timef " >= " tstart " AND " timef " <= " tend " ORDER BY " timef " ASC"))
(zeroth-point (conc "SELECT " timef "," varfn "," valfn " FROM " tablen " WHERE " varfn "='" fieldname "' AND " timef " < " tstart " LIMIT 1")))
(hash-table-set! res-ht fieldname ;; (fetch-rows (sql db qrystr)))))
(reverse
(dbi:fold-row
(lambda (res t var val)
(cons (vector t var val) res))
'() db all-dat-qrystr)))
(let ((zeropt (handle-exceptions
exn
#f
(dbi:get-one-row db all-dat-qrystr))))
(if zeropt ;; NOTE: Add zeropt to the beginning of the list as the list was reversed above.
(hash-table-set! res-ht
fieldname
(cons
(apply vector tstart (cdr zeropt))
(hash-table-ref/default res-ht fieldname '())))))))
fields)
|