Overview
Comment: | Basic initialization of dbstruct works. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
Files: | files | file ages | folders |
SHA1: |
1b388397ae13c1d77260b1acb4a7ad3c |
User & Date: | matt on 2021-04-23 23:57:23 |
Other Links: | branch diff | manifest | tags |
Context
2021-04-25
| ||
05:14 | Removed references to homehost check-in: 1d98834276 user: matt tags: v1.6584-ck5 | |
2021-04-23
| ||
23:57 | Basic initialization of dbstruct works. check-in: 1b388397ae user: matt tags: v1.6584-ck5 | |
05:36 | wip, compiles check-in: cff44e26a5 user: matt tags: v1.6584-ck5 | |
Changes
Modified dbmod.scm from [d798812f86] to [98add3bd5b].
︙ | ︙ | |||
145 146 147 148 149 150 151 | ;; (define (db:get-dbdat dbstruct run-id) (let ((dbdat (dbr:dbstruct-get-dbdat dbstruct run-id))) (if dbdat dbdat (let* ((dbfile (db:run-id->path run-id)) (newdbdat (db:open-dbdat run-id db:initialize-db))) | | | 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | ;; (define (db:get-dbdat dbstruct run-id) (let ((dbdat (dbr:dbstruct-get-dbdat dbstruct run-id))) (if dbdat dbdat (let* ((dbfile (db:run-id->path run-id)) (newdbdat (db:open-dbdat run-id db:initialize-db))) (dbr:dbstruct-dbdat-put! dbstruct run-id newdbdat) newdbdat)))) ;; get the inmem db for actual db operations ;; (define (db:get-inmem dbstruct run-id) (dbr:dbdat-inmem (db:get-dbdat dbstruct run-id))) |
︙ | ︙ | |||
526 527 528 529 530 531 532 | '("reviewed" #f) '("iterated" #f) '("avg_runtime" #f) '("avg_disk" #f) '("tags" #f) '("jobgroup" #f))))) | | | | 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 | '("reviewed" #f) '("iterated" #f) '("avg_runtime" #f) '("avg_disk" #f) '("tags" #f) '("jobgroup" #f))))) (define (db:sync-all-tables-list) (append (db:sync-main-list) db:sync-tests-only)) ;; use bunch of Unix commands to try to break the lock and recreate the db ;; (define (db:move-and-recreate-db dbdat) (let* ((dbpath (dbr:dbdat-fname dbdat)) (dbdir (pathname-directory dbpath)) |
︙ | ︙ | |||
607 608 609 610 611 612 613 | (sqlite3:execute "DELETE FROM servers WHERE state LIKE 'defunct%';")) (else (sqlite3:execute db "vacuum;"))) (sqlite3:finalize! db) #t)))))) | < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 | (sqlite3:execute "DELETE FROM servers WHERE state LIKE 'defunct%';")) (else (sqlite3:execute db "vacuum;"))) (sqlite3:finalize! db) #t)))))) (define (db:sync-one-table fromdb todb tabledat last-update numrecs) (let* ((tablename (car tabledat)) (fields (cdr tabledat)) (has-last-update (member "last_update" fields)) (use-last-update (cond ((and has-last-update (member "last_update" fields)) #t) ;; if given a number, just use it for all fields |
︙ | ︙ | |||
713 714 715 716 717 718 719 | (fromdat '()) (fromdats '()) (totrecords 0) (batch-len (string->number (or (configf:lookup *configdat* "sync" "batchsize") "100"))) (todat (make-hash-table)) (count 0) (field-names (map car fields)) | | | | < < | < | < < < | | 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 | (fromdat '()) (fromdats '()) (totrecords 0) (batch-len (string->number (or (configf:lookup *configdat* "sync" "batchsize") "100"))) (todat (make-hash-table)) (count 0) (field-names (map car fields)) ;; (delay-handicap (string->number (or (configf:lookup *configdat* "sync" "delay-handicap") "0"))) ) ;; set up the field->num table (for-each (lambda (field) (hash-table-set! field->num field count) (set! count (+ count 1))) fields) ;; read the source table (sqlite3:for-each-row (lambda (a . b) (set! fromdat (cons (apply vector a b) fromdat)) (if (> (length fromdat) batch-len) (begin (set! fromdats (cons fromdat fromdats)) (set! fromdat '()) (set! totrecords (+ totrecords 1))))) fromdb ;; (dbr:dbdat-db fromdb) full-sel) ;; tack on remaining records in fromdat (if (not (null? fromdat)) (set! fromdats (cons fromdat fromdats))) (if (common:low-noise-print 120 "sync-records") (debug:print-info 4 *default-log-port* "found " totrecords " records to sync")) ;; read the target table; BBHERE (sqlite3:for-each-row (lambda (a . b) (hash-table-set! todat a (apply vector a b))) todb ;; (dbr:dbdat-db todb) full-sel) ;; delay stuff was here ;; first pass implementation, just insert all changed rows (let* ((db todb) ;; (dbr:dbdat-db targdb)) (drp-trigger (if (member "last_update" field-names) (db:drop-trigger db tablename) #f)) (is-trigger-dropped (if (member "last_update" field-names) (db:is-trigger-dropped db tablename) #f)) (stmth (sqlite3:prepare db full-ins))) |
︙ | ︙ | |||
794 795 796 797 798 799 800 | (begin (apply sqlite3:execute stmth (vector->list fromrow)) (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0))))))) fromdat-lst)))) fromdats) (sqlite3:finalize! stmth) (if (member "last_update" field-names) | | | > > > > > > > > > > > > > > > > > > > > > > | | 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 | (begin (apply sqlite3:execute stmth (vector->list fromrow)) (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0))))))) fromdat-lst)))) fromdats) (sqlite3:finalize! stmth) (if (member "last_update" field-names) (db:create-trigger db tablename))))) ;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) ) ;; db's are sqlite3 handles ;; ;; if last-update specified ("field-name" . time-in-seconds) ;; then sync only records where field-name >= time-in-seconds ;; IFF field-name exists ;; (define (db:sync-tables tbls last-update fromdb todb) ;; NOTE: I'm moving all the checking OUT of this routine. Check for read/write access, existance, etc ;; BEFORE calling this sync (let ((stmts (make-hash-table)) ;; table-field => stmt (all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 )) (numrecs (make-hash-table)) (start-time (current-milliseconds)) (tot-count 0)) (for-each ;; table (lambda (tabledat) (db:sync-one-table fromdb todb tabledat last-update numrecs)) tbls) (let* ((runtime (- (current-milliseconds) start-time)) (should-print (or (debug:debug-mode 12) (common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate. (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms")) (for-each (lambda (dat) (let ((tblname (car dat)) (count (cdr dat))) (set! tot-count (+ tot-count count)) (if (> count 0) (if should-print (debug:print 0 *default-log-port* (format #f " ~10a ~5a" tblname count)))))) (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b)))))) tot-count)) (define (db:patch-schema-rundb frundb) ;; ;; remove this some time after September 2016 (added in version v1.6031 ;; (for-each (lambda (table-name) |
︙ | ︙ | |||
1242 1243 1244 1245 1246 1247 1248 | (conc "update_" tbl-name "_trigger")))) (for-each (lambda (key) (if (equal? (car key) trigger-name) (sqlite3:execute db (cadr key)))) db:trigger-list))) | | | | 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 | (conc "update_" tbl-name "_trigger")))) (for-each (lambda (key) (if (equal? (car key) trigger-name) (sqlite3:execute db (cadr key)))) db:trigger-list))) (define (db:initialize-db db) (assert *configinfo* "ERROR: db:initialize-db called before configfiles loaded. This is fatal.") (let* ((configdat (car *configinfo*)) ;; tut tut, global warning... (keys (keys:config-get-fields configdat)) (havekeys (> (length keys) 0)) (keystr (keys->keystr keys)) (fieldstr (keys:make-key/field-string configdat)) #;(db (dbr:dbdat-db dbdat))) (for-each (lambda (key) (let ((keyn key)) (if (member (string-downcase keyn) (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour")) (begin (print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and <linktree>/.db before trying again.") |
︙ | ︙ |
Modified megatest.scm from [b5b98a6d56] to [ef10051c2f].
︙ | ︙ | |||
2454 2455 2456 2457 2458 2459 2460 | (if (or (getenv "MT_RUNSCRIPT") (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup)) (dbstruct (if (and toppath (common:on-homehost?)) | | | 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 | (if (or (getenv "MT_RUNSCRIPT") (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup)) (dbstruct (if (and toppath (common:on-homehost?)) (db:setup #f) #f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f))) (if *toppath* (cond ((getenv "MT_RUNSCRIPT") ;; How to run megatest scripts ;; ;; #!/bin/bash |
︙ | ︙ |