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 "")) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -12,11 +12,11 @@ ;; 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) @@ -494,32 +494,35 @@ (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 (make-refdb:csv) - (vector +(define (actual-make-refdb:csv) + (make-refdb:csv (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")) @@ -568,24 +571,24 @@ (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)) @@ -602,13 +605,13 @@ ;; (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 ()