Index: fdb_records.scm ================================================================== --- fdb_records.scm +++ fdb_records.scm @@ -1,19 +1,24 @@ ;; Single record for managing a filedb ;; make-vector-record "Filedb record" filedb fdb db dbpath pathcache idcache partcache ;; Filedb record -(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)) - -;; 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)) +(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)) + +;; 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)) Index: filedb.scm ================================================================== --- filedb.scm +++ filedb.scm @@ -13,20 +13,19 @@ (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 @@ -42,20 +41,20 @@ 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) @@ -112,12 +111,12 @@ (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 "/"))) @@ -154,11 +153,11 @@ (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 ;; @@ -172,11 +171,11 @@ (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) @@ -183,12 +182,12 @@ (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 @@ -196,11 +195,11 @@ (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=?;" @@ -208,11 +207,11 @@ 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))) @@ -220,12 +219,12 @@ (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 ""))