| ︙ | | | ︙ | |
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
|
(define (filedb:finalize-db! fdb)
(dbi:close (filedb:fdb-get-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))
(dbi:for-each-row
(lambda (num) (set! id-num num)) stmt path)
(dbi:close stmt)
id-num))
(define (filedb:get-path-id db path parent)
(let ((stmt (sqlite3:prepare db "SELECT id FROM paths WHERE path=? AND parent_id=?;"))
(id-num #f))
(dbi:for-each-row
(lambda (num) (set! id-num num)) stmt path parent)
(dbi:close stmt)
id-num))
(define (filedb:add-base db path)
(let ((existing (filedb:get-base-id db path)))
(if existing #f
(begin
|
|
|
|
|
|
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
|
(define (filedb:finalize-db! fdb)
(dbi:close (filedb:fdb-get-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 (dbi:prepare db "SELECT id FROM bases WHERE base=?;"))
(id-num #f))
(dbi:for-each-row
(lambda (num) (set! id-num (vector-ref num 0))) stmt path)
(dbi:close stmt)
id-num))
(define (filedb:get-path-id db path parent)
(let ((stmt (dbi:prepare db "SELECT id FROM paths WHERE path=? AND parent_id=?;"))
(id-num #f))
(dbi:for-each-row
(lambda (num) (set! id-num (vector-ref num 0))) stmt path parent)
(dbi:close stmt)
id-num))
(define (filedb:add-base db path)
(let ((existing (filedb:get-base-id db path)))
(if existing #f
(begin
|
| ︙ | | | ︙ | |
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
(vector-ref statinfo 4) ;; gid
(vector-ref statinfo 5) ;; size
(vector-ref statinfo 8) ;; mtime
)
(dbi:close stmt))) ;; (filedb:get-current-time-string))))
(define (filedb:add-path db path parent)
(let ((stmt (sqlite3:prepare db "INSERT INTO paths (path,parent_id) VALUES (?,?);")))
(dbi:exec stmt path parent)
(dbi:close stmt)))
(define (filedb:register-path fdb path #!key (save-stat #f))
(let* ((db (filedb:fdb-get-db fdb))
(pathcache (filedb:fdb-get-pathcache fdb))
(stat (if save-stat (file-stat path #t)))
|
|
|
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
(vector-ref statinfo 4) ;; gid
(vector-ref statinfo 5) ;; size
(vector-ref statinfo 8) ;; mtime
)
(dbi:close stmt))) ;; (filedb:get-current-time-string))))
(define (filedb:add-path db path parent)
(let ((stmt (dbi:prepare db "INSERT INTO paths (path,parent_id) VALUES (?,?);")))
(dbi:exec stmt path parent)
(dbi:close stmt)))
(define (filedb:register-path fdb path #!key (save-stat #f))
(let* ((db (filedb:fdb-get-db fdb))
(pathcache (filedb:fdb-get-pathcache fdb))
(stat (if save-stat (file-stat path #t)))
|
| ︙ | | | ︙ | |
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
|
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))
(stmt (sqlite3:prepare db "SELECT id FROM paths WHERE path like ?;"))
(result '()))
(dbi:for-each-row
(lambda (num)
(action num)
(set! result (cons num result))) stmt pattern)
(dbi:close stmt)
result))
(define (filedb:get-path-record fdb id)
(let* ((db (filedb:fdb-get-db fdb))
(partcache (filedb:fdb-get-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))
(dbi:for-each-row
(lambda (path parent_id)(set! result (list path parent_id))) stmt id)
(hash-table-set! partcache id result)
(dbi:close stmt)
result))))
(define (filedb:get-children fdb parent-id)
(let* ((db (filedb:fdb-get-db fdb))
(res '()))
|
|
|
|
|
|
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
|
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))
(stmt (dbi:prepare db "SELECT id FROM paths WHERE path like ?;"))
(result '()))
(dbi:for-each-row
(lambda (num)
(action (vector-ref num 0))
(set! result (cons num result))) stmt pattern)
(dbi:close stmt)
result))
(define (filedb:get-path-record fdb id)
(let* ((db (filedb:fdb-get-db fdb))
(partcache (filedb:fdb-get-partcache fdb))
(dat (hash-table-ref/default partcache id #f)))
(if dat dat
(let ((stmt (dbi:prepare db "SELECT path,parent_id FROM paths WHERE id=?;"))
(result #f))
(dbi:for-each-row
(lambda (output) (lambda (path parent_id)(set! result (list path parent_id)))) stmt id)
(hash-table-set! partcache id result)
(dbi:close stmt)
result))))
(define (filedb:get-children fdb parent-id)
(let* ((db (filedb:fdb-get-db fdb))
(res '()))
|
| ︙ | | | ︙ | |
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
;; 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))
(res '()))
;; first get the children that have no children
(dbi: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))
|
>
|
|
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
;; 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))
(res '()))
;; first get the children that have no children
(dbi:for-each-row
(lambda (output)
(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))
|
| ︙ | | | ︙ | |