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")
(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
|