Megatest

Diff
Login

Differences From Artifact [3f78d1737e]:

To Artifact [de41021734]:


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
114
115
116
26
27
28
29
30
31
32



























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
(require-extension (srfi 18) extras)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

(declare (unit sdb))

;; 
(define (sdb:open fname)
  (let* ((dbpath    (pathname-directory fname))
	 (dbexists  (let ((fe (common:file-exists? fname)))
		      (if fe 
			  fe
			  (begin
			    (create-directory dbpath #t)
			    #f))))
	 (sdb        (sqlite3:open-database fname))
	 (handler   (make-busy-timeout 136000)))
    (sqlite3:set-busy-handler! sdb handler)
    (if (not dbexists)
	(sdb:initialize sdb))
    (sqlite3:execute sdb "PRAGMA synchronous = 1;")
    sdb))

(define (sdb:initialize sdb)
  (sqlite3:execute sdb "CREATE TABLE IF NOT EXISTS strs
                           (id  INTEGER PRIMARY KEY,
                            str TEXT,
                        CONSTRAINT str UNIQUE (str));")
  (sqlite3:execute sdb "CREATE INDEX IF NOT EXISTS strindx ON strs (str);"))

;; (define sumup (let ((a 0))(lambda (x)(set! a (+ x a)) a)))

(define (sdb:register-string sdb str)
  (sqlite3:execute sdb "INSERT OR IGNORE INTO strs (str) VALUES (?);" str))

(define (sdb:string->id sdb str-cache str)
  (let ((id (hash-table-ref/default str-cache str #f)))
    (if (not id)
	(sqlite3:for-each-row
	 (lambda (sid)
	   (set! id sid)
	   (hash-table-set! str-cache str id))
	 sdb
	 "SELECT id FROM strs WHERE str=?;" str))
    id))

(define (sdb:id->string sdb id-cache id)
  (let ((str (hash-table-ref/default id-cache id #f)))
    (if (not str)
	(sqlite3:for-each-row
	 (lambda (istr)
	   (set! str istr)
	   (hash-table-set! id-cache id str))
	 sdb
	 "SELECT str FROM strs WHERE id=?;" id))
    str))

;; Numbers get passed though in both directions
;;
(define (make-sdb:qry fname)
  (let ((sdb    #f)
	(scache (make-hash-table))
	(icache (make-hash-table)))
    (lambda (cmd var)
      (case cmd
	((setup)   (set! sdb (if (not sdb)
				 (sdb:open (if var var fname)))))
	((setdb)    (set! sdb var))
	((getdb)    sdb)
	((finalize) (if sdb
			(begin
			  (sqlite3:finalize! sdb)
			  (set! sdb #f))))
	((getid)     (let ((id (if (or (number? var)
				       (string->number var))
				   var
				   (sdb:string->id sdb scache var))))
		       (if id
			   id
			   (begin
			     (sdb:register-string sdb var)
			     (sdb:string->id sdb scache var)))))
	((getstr)    (if (or (number? var)
			     (string->number var))
			 (sdb:id->string sdb icache var)
			 var))
	((passid)    var)
	((passstr)   var)
	(else #f)))))