Changes In Branch inline-vec-to-defstruct Excluding Merge-Ins
This is equivalent to a diff from ba8dfaa7fe to fb18a8da9e
2016-01-29
| ||
08:58 | re-refactor dbr:dbstruct check-in: 3becef064c user: mrwellan tags: re-refactor-vec2defstruct | |
2016-01-14
| ||
15:17 | refactor-dbr:dbstruct check-in: 8bd82d02ff user: mrwellan tags: refactor-dbr:dbstruct | |
2016-01-13
| ||
16:23 | converted filedb:fdb from vec to defstruct Closed-Leaf check-in: fb18a8da9e user: bjbarcla tags: inline-vec-to-defstruct | |
15:35 | Added defstruct changes to megatest.scm check-in: 74dc16bf61 user: ritikaag tags: inline-vec-to-defstruct | |
2016-01-11
| ||
16:58 | Bump version to v1.6029 check-in: 3aa6e44158 user: icfadm tags: v1.60, v1.6029 | |
11:23 | Create new branch named "inline-vec-to-defstruct" check-in: 26c4c3485f user: mrwellan tags: inline-vec-to-defstruct | |
11:22 | Minor tweak to help check-in: ba8dfaa7fe user: mrwellan tags: v1.60 | |
2016-01-08
| ||
18:19 | Added sort for field on tests in -list-runs check-in: ae0c081d5c user: matt tags: v1.60 | |
Modified fdb_records.scm from [bbb0371221] to [423ddbb678].
1 2 3 | ;; Single record for managing a filedb ;; make-vector-record "Filedb record" filedb fdb db dbpath pathcache idcache partcache ;; Filedb record | > > > > | | | | | | | | | | | > | | | | | 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)) ;; 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)) |
Modified filedb.scm from [91e90bcdc7] to [7542371360].
︙ | ︙ | |||
11 12 13 14 15 16 17 | (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") | < | | | | | | | | | | 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))) (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) (update-filedb:fdb fdb db: #f) fdb)) (define (filedb:reopen-db fdb) (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-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 | (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)) | | | | 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-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 | (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)) | | | | | | | | | | 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-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-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-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-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-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-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 | ;; (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) | | | 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 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 | (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))))) ;; csv processing record | > > > | < > | | | | | | | | | | | | 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) (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 (get-dat results sheetname) (or (hash-table-ref/default results sheetname #f) (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 | ;; (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)) | | | | | | | | | | | | 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-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-maxrow dat)) (newrown (+ lastn 1))) (refdb:csv-maxrow-set! dat newrown) newrown))) (coln (or currcoln (let* ((lastn (refdb:csv-maxcol dat)) (newcoln (+ lastn 1))) (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-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) |
︙ | ︙ |