This is equivalent to a diff from
ba8dfaa7fe
to fb18a8da9e
Modified fdb_records.scm
from [bbb0371221]
to [423ddbb678].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
|
;; Single record for managing a filedb
;; make-vector-record "Filedb record" filedb fdb db dbpath pathcache idcache partcache
;; Filedb record
(use defstruct)
(defstruct filedb:fdb db dbpath pathcache idcache partcache db! dbpath! pathcache! idcache! partcache!)
;; BB: following replaced by defstruct filedb:fdb --
(define (make-filedb:fdb)(make-vector 5))
(define-inline (filedb:fdb-get-db vec) (vector-ref vec 0))
(define-inline (filedb:fdb-get-dbpath vec) (vector-ref vec 1))
(define-inline (filedb:fdb-get-pathcache vec) (vector-ref vec 2))
(define-inline (filedb:fdb-get-idcache vec) (vector-ref vec 3))
(define-inline (filedb:fdb-get-partcache vec) (vector-ref vec 4))
(define-inline (filedb:fdb-set-db! vec val)(vector-set! vec 0 val))
(define-inline (filedb:fdb-set-dbpath! vec val)(vector-set! vec 1 val))
(define-inline (filedb:fdb-set-pathcache! vec val)(vector-set! vec 2 val))
(define-inline (filedb:fdb-set-idcache! vec val)(vector-set! vec 3 val))
(define-inline (filedb:fdb-set-partcache! vec val)(vector-set! vec 4 val))
;;(define (make-filedb:fdb)(make-vector 5))
;;(define-inline (filedb:fdb-get-db vec) (vector-ref vec 0))
;;(define-inline (filedb:fdb-get-dbpath vec) (vector-ref vec 1))
;;(define-inline (filedb:fdb-get-pathcache vec) (vector-ref vec 2))
;;(define-inline (filedb:fdb-get-idcache vec) (vector-ref vec 3))
;;(define-inline (filedb:fdb-get-partcache vec) (vector-ref vec 4))
;;(define-inline (filedb:fdb-set-db! vec val)(vector-set! vec 0 val))
;;(define-inline (filedb:fdb-set-dbpath! vec val)(vector-set! vec 1 val))
;;(define-inline (filedb:fdb-set-pathcache! vec val)(vector-set! vec 2 val))
;;(define-inline (filedb:fdb-set-idcache! vec val)(vector-set! vec 3 val))
;;(define-inline (filedb:fdb-set-partcache! vec val)(vector-set! vec 4 val))
;; BB: following is not used, commenting out --
;; children records, should have use something other than "child"
(define-inline (filedb:child-get-id vec) (vector-ref vec 0))
(define-inline (filedb:child-get-path vec) (vector-ref vec 1))
(define-inline (filedb:child-get-parent_id vec)(vector-ref vec 2))
;;; children records, should have use something other than "child"
;;(define-inline (filedb:child-get-id vec) (vector-ref vec 0))
;;(define-inline (filedb:child-get-path vec) (vector-ref vec 1))
;;(define-inline (filedb:child-get-parent_id vec)(vector-ref vec 2))
|
Modified filedb.scm
from [91e90bcdc7]
to [7542371360].
︙ | | |
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
|
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
|
-
-
-
-
-
-
+
+
+
+
+
-
+
-
-
+
+
-
+
|
(use sqlite3 srfi-1 posix regex srfi-69 srfi-13 posix-extras)
(import (prefix sqlite3 sqlite3:))
(declare (unit filedb))
(include "fdb_records.scm")
;; (include "settings.scm")
(define (filedb:open-db dbpath)
(let* ((fdb (make-filedb:fdb))
(dbexists (file-exists? dbpath))
(db (sqlite3:open-database dbpath)))
(filedb:fdb-set-db! fdb db)
(filedb:fdb-set-dbpath! fdb dbpath)
(filedb:fdb-set-pathcache! fdb (make-hash-table))
(filedb:fdb-set-idcache! fdb (make-hash-table))
(filedb:fdb-set-partcache! fdb (make-hash-table))
(update-filedb:fdb fdb db: db)
(update-filedb:fdb fdb dbpath: dbpath)
(update-filedb:fdb fdb pathcache: (make-hash-table))
(update-filedb:fdb fdb idcache: (make-hash-table))
(update-filedb:fdb fdb partcache: (make-hash-table))
(sqlite3:set-busy-handler! db (make-busy-timeout 136000))
(if (not dbexists)
(begin
(sqlite3:execute db "PRAGMA synchronous = OFF;")
(sqlite3:execute db "CREATE TABLE names (id INTEGER PRIMARY KEY,name TEST);") ;; for future use - change path in paths table to path_id
(sqlite3:execute db "CREATE INDEX name_index ON names (name);")
;; NB// We store a useful subset of file attributes but do not attempt to store all
(sqlite3:execute db "CREATE TABLE paths (id INTEGER PRIMARY KEY,
path TEXT,
parent_id INTEGER,
mode INTEGER DEFAULT -1,
uid INTEGER DEFAULT -1,
gid INTEGER DEFAULT -1,
size INTEGER DEFAULT -1,
mtime INTEGER DEFAULT -1);")
(sqlite3:execute db "CREATE INDEX path_index ON paths (path,parent_id);")
(sqlite3:execute db "CREATE TABLE bases (id INTEGER PRIMARY KEY,base TEXT, updated TIMESTAMP);")))
;; close the sqlite3 db and open it as needed
(filedb:finalize-db! fdb)
(filedb:fdb-set-db! fdb #f)
(update-filedb:fdb fdb db: #f)
fdb))
(define (filedb:reopen-db fdb)
(let ((db (sqlite3:open-database (filedb:fdb-get-dbpath fdb))))
(filedb:fdb-set-db! fdb db)
(let ((db (sqlite3:open-database (filedb:fdb-dbpath fdb))))
(update-filedb:fdb fdb db: db)
(sqlite3:set-busy-handler! db (make-busy-timeout 136000))))
(define (filedb:finalize-db! fdb)
(sqlite3:finalize! (filedb:fdb-get-db fdb)))
(sqlite3:finalize! (filedb:fdb-db fdb)))
(define (filedb:get-current-time-string)
(string-chomp (time->string (seconds->local-time (current-seconds)))))
(define (filedb:get-base-id db path)
(let ((stmt (sqlite3:prepare db "SELECT id FROM bases WHERE base=?;"))
(id-num #f))
|
︙ | | |
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
-
-
+
+
|
(define (filedb:add-path db path parent)
(let ((stmt (sqlite3:prepare db "INSERT INTO paths (path,parent_id) VALUES (?,?);")))
(sqlite3:execute stmt path parent)
(sqlite3:finalize! stmt)))
(define (filedb:register-path fdb path #!key (save-stat #f))
(let* ((db (filedb:fdb-get-db fdb))
(pathcache (filedb:fdb-get-pathcache fdb))
(let* ((db (filedb:fdb-db fdb))
(pathcache (filedb:fdb-pathcache fdb))
(stat (if save-stat (file-stat path #t)))
(id (hash-table-ref/default pathcache path #f)))
(if (not db)(filedb:reopen-db fdb))
(if id id
(let ((plist (string-split path "/")))
(let loop ((head (car plist))
(tail (cdr plist))
|
︙ | | |
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
|
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
-
+
-
+
-
-
+
+
-
+
-
+
-
-
+
+
|
(if (= (modulo lc 100) 0)
(print " " lc " files"))
(loop (read-line p)(+ lc 1)))))))
(define (filedb:update fdb path #!key (save-stat #f))
;; first get the realpath and add it to the bases table
(let ((real-path path) ;; (filedb:get-real-path path))
(db (filedb:fdb-get-db fdb)))
(db (filedb:fdb-db fdb)))
(filedb:add-base db real-path)
(filedb:update-recursively fdb path save-stat: save-stat)))
;; not used and broken
;;
(define (filedb:get-real-path path)
(let* ((p (open-input-pipe (string-append real-path " " (regexp-escape path))))
(pth (read-line p)))
(if (eof-object? pth) path
(begin
(close-input-port p)
pth))))
(define (filedb:drop-base fdb path)
(print "Sorry, I don't do anything yet"))
(define (filedb:find-all fdb pattern action)
(let* ((db (filedb:fdb-get-db fdb))
(let* ((db (filedb:fdb-db fdb))
(stmt (sqlite3:prepare db "SELECT id FROM paths WHERE path like ?;"))
(result '()))
(sqlite3:for-each-row
(lambda (num)
(action num)
(set! result (cons num result))) stmt pattern)
(sqlite3:finalize! stmt)
result))
(define (filedb:get-path-record fdb id)
(let* ((db (filedb:fdb-get-db fdb))
(partcache (filedb:fdb-get-partcache fdb))
(let* ((db (filedb:fdb-db fdb))
(partcache (filedb:fdb-partcache fdb))
(dat (hash-table-ref/default partcache id #f)))
(if dat dat
(let ((stmt (sqlite3:prepare db "SELECT path,parent_id FROM paths WHERE id=?;"))
(result #f))
(sqlite3:for-each-row
(lambda (path parent_id)(set! result (list path parent_id))) stmt id)
(hash-table-set! partcache id result)
(sqlite3:finalize! stmt)
result))))
(define (filedb:get-children fdb parent-id)
(let* ((db (filedb:fdb-get-db fdb))
(let* ((db (filedb:fdb-db fdb))
(res '()))
(sqlite3:for-each-row
(lambda (id path parent-id)
(set! res (cons (vector id path parent-id) res)))
db "SELECT id,path,parent_id FROM paths WHERE parent_id=?;"
parent-id)
res))
;; retrieve all that have children and those without
;; children that match patt
(define (filedb:get-children-patt fdb parent-id search-patt)
(let* ((db (filedb:fdb-get-db fdb))
(let* ((db (filedb:fdb-db fdb))
(res '()))
;; first get the children that have no children
(sqlite3:for-each-row
(lambda (id path parent-id)
(set! res (cons (vector id path parent-id) res)))
db "SELECT id,path,parent_id FROM paths WHERE parent_id=? AND
(id IN (SELECT parent_id FROM paths) OR path LIKE ?);"
parent-id search-patt)
res))
(define (filedb:get-path fdb id)
(let* ((db (filedb:fdb-get-db fdb))
(idcache (filedb:fdb-get-idcache fdb))
(let* ((db (filedb:fdb-db fdb))
(idcache (filedb:fdb-idcache fdb))
(path (hash-table-ref/default idcache id #f)))
(if (not db)(filedb:reopen-db fdb))
(if path path
(let loop ((curr-id id)
(path ""))
(let ((path-record (filedb:get-path-record fdb curr-id)))
(if (not path-record) #f ;; this id has no path
|
︙ | | |
Modified megatest.scm
from [968f531533]
to [cf5035193a].
︙ | | |
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
-
+
|
;; (include "common.scm")
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras)
http-client srfi-18 extras format) ;; zmq extras)
http-client srfi-18 extras format defstruct) ;; zmq extras)
;; Added for csv stuff - will be removed
;;
(use sparse-vectors)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
|
︙ | | |
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
|
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
+
+
+
-
+
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
|
(let ((row (sparse-vector-ref a x)))
(if row
(sparse-vector-set! row y val)
(let ((new-row (make-sparse-vector)))
(sparse-vector-set! a x new-row)
(sparse-vector-set! new-row y val)))))
(defstruct refdb:csv svec rows cols maxrow maxcol)
;; csv processing record
(define (actual-make-refdb:csv)
(define (make-refdb:csv)
(make-refdb:csv
(vector
(make-sparse-array)
(make-hash-table)
(make-hash-table)
0
0))
(define-inline (refdb:csv-get-svec vec) (vector-ref vec 0))
(define-inline (refdb:csv-get-rows vec) (vector-ref vec 1))
(define-inline (refdb:csv-get-cols vec) (vector-ref vec 2))
(define-inline (refdb:csv-get-maxrow vec) (vector-ref vec 3))
(define-inline (refdb:csv-get-maxcol vec) (vector-ref vec 4))
(define-inline (refdb:csv-set-svec! vec val)(vector-set! vec 0 val))
(define-inline (refdb:csv-set-rows! vec val)(vector-set! vec 1 val))
(define-inline (refdb:csv-set-cols! vec val)(vector-set! vec 2 val))
(define-inline (refdb:csv-set-maxrow! vec val)(vector-set! vec 3 val))
(define-inline (refdb:csv-set-maxcol! vec val)(vector-set! vec 4 val))
;; (define-inline (refdb:csv-get-svec vec) (vector-ref vec 0))
;; (define-inline (refdb:csv-get-rows vec) (vector-ref vec 1))
;; (define-inline (refdb:csv-get-cols vec) (vector-ref vec 2))
;; (define-inline (refdb:csv-get-maxrow vec) (vector-ref vec 3))
;; (define-inline (refdb:csv-get-maxcol vec) (vector-ref vec 4))
;; (define-inline (refdb:csv-set-svec! vec val)(vector-set! vec 0 val))
;; (define-inline (refdb:csv-set-rows! vec val)(vector-set! vec 1 val))
;; (define-inline (refdb:csv-set-cols! vec val)(vector-set! vec 2 val))
;; (define-inline (refdb:csv-set-maxrow! vec val)(vector-set! vec 3 val))
;; (define-inline (refdb:csv-set-maxcol! vec val)(vector-set! vec 4 val))
(define (get-dat results sheetname)
(or (hash-table-ref/default results sheetname #f)
(let ((tmp-vec (make-refdb:csv)))
(let ((tmp-vec (actual-make-refdb:csv)))
(hash-table-set! results sheetname tmp-vec)
tmp-vec)))
(if (args:get-arg "-refdb2dat")
(let* ((input-db (args:get-arg "-refdb2dat"))
(out-file (args:get-arg "-o"))
(out-fmt (or (args:get-arg "-dumpmode") "scheme"))
|
︙ | | |
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
|
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
|
-
-
-
+
+
+
-
+
-
+
-
+
-
+
-
-
-
+
+
+
|
;; (print "data=")
;; (pp data)
(configf:map-all-hier-alist
data
(lambda (sheetname sectionname varname val)
;; (print "sheetname: " sheetname ", sectionname: " sectionname ", varname: " varname ", val: " val)
(let* ((dat (get-dat results sheetname))
(vec (refdb:csv-get-svec dat))
(rownames (refdb:csv-get-rows dat))
(colnames (refdb:csv-get-cols dat))
(vec (refdb:csv-svec dat))
(rownames (refdb:csv-rows dat))
(colnames (refdb:csv-cols dat))
(currrown (hash-table-ref/default rownames varname #f))
(currcoln (hash-table-ref/default colnames sectionname #f))
(rown (or currrown
(let* ((lastn (refdb:csv-get-maxrow dat))
(let* ((lastn (refdb:csv-maxrow dat))
(newrown (+ lastn 1)))
(refdb:csv-set-maxrow! dat newrown)
(refdb:csv-maxrow-set! dat newrown)
newrown)))
(coln (or currcoln
(let* ((lastn (refdb:csv-get-maxcol dat))
(let* ((lastn (refdb:csv-maxcol dat))
(newcoln (+ lastn 1)))
(refdb:csv-set-maxcol! dat newcoln)
(refdb:csv-maxcol-set! dat newcoln)
newcoln))))
(if (not (sparse-array-ref vec 0 coln)) ;; (eq? rown 0)
(begin
(sparse-array-set! vec 0 coln sectionname)
;; (print "sparse-array-ref " 0 "," coln "=" (sparse-array-ref vec 0 coln))
))
(if (not (sparse-array-ref vec rown 0)) ;; (eq? coln 0)
(begin
(sparse-array-set! vec rown 0 varname)
;; (print "sparse-array-ref " rown "," 0 "=" (sparse-array-ref vec rown 0))
))
(if (not currrown)(hash-table-set! rownames varname rown))
(if (not currcoln)(hash-table-set! colnames sectionname coln))
;; (print "dat=" dat ", rown=" rown ", coln=" coln)
(sparse-array-set! vec rown coln val)
;; (print "sparse-array-ref " rown "," coln "=" (sparse-array-ref vec rown coln))
)))
(for-each
(lambda (sheetname)
(let* ((sheetdat (get-dat results sheetname))
(svec (refdb:csv-get-svec sheetdat))
(maxrow (refdb:csv-get-maxrow sheetdat))
(maxcol (refdb:csv-get-maxcol sheetdat))
(svec (refdb:csv-svec sheetdat))
(maxrow (refdb:csv-maxrow sheetdat))
(maxcol (refdb:csv-maxcol sheetdat))
(fname (if out-file
(string-substitute "%s" sheetname out-file) ;; "/foo/bar/%s.csv")
(conc sheetname ".csv"))))
(with-output-to-file fname
(lambda ()
;; (print "Sheetname: " sheetname)
(let loop ((row 0)
|
︙ | | |