Overview
Comment: | made db:get-changed-run-ids look at times from all .db\* files, added descriptive comment headers to some functions |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.70 |
Files: | files | file ages | folders |
SHA1: |
73a720d8d51730bf2e9d574559e134be |
User & Date: | mmgraham on 2023-03-19 22:37:19 |
Other Links: | branch diff | manifest | tags |
Context
2023-03-20
| ||
10:55 | Changed megatest verion to 1.7013 check-in: c9d037cad9 user: mmgraham tags: v1.70 | |
2023-03-19
| ||
22:37 | made db:get-changed-run-ids look at times from all .db\* files, added descriptive comment headers to some functions check-in: 73a720d8d5 user: mmgraham tags: v1.70 | |
2023-02-15
| ||
16:12 | backed out the dashboard change from checkin ad100 check-in: ca906d5897 user: mmgraham tags: v1.70, v1.7012 | |
Changes
Modified db.scm from [9dde16de83] to [4b9a66d306].
︙ | ︙ | |||
1669 1670 1671 1672 1673 1674 1675 | (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " target: " target " offset: " offset " limit: " count) res)) ;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db) ;; ;; NOTE: This DOESN'T (necessarily) get the real run ids, but the number of the <number>.db!! | > > > > > | | | | | | | | | | | | > > | 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 | (debug:print-info 11 *default-log-port* "db:get-runs END qrystr: " qrystr " target: " target " offset: " offset " limit: " count) res)) ;; TODO: Switch this to use max(update_time) from each run db? Then if using a server there is no disk traffic (using inmem db) ;; ;; NOTE: This DOESN'T (necessarily) get the real run ids, but the number of the <number>.db!! (define (db:get-changed-run-ids since-time) (let* ((dbdir (db:dbfile-path)) ;; (configf:lookup *configdat* "setup" "dbdir")) (alldbs (glob (conc dbdir "/.megatest/[0-9]*.db*"))) (changed (filter (lambda (dbfile) (> (file-modification-time dbfile) since-time)) alldbs))) (delete-duplicates (map (lambda (dbfile) (let* ((res (string-match ".*\\/(\\d\\d)\\.db*" dbfile))) (if res (string->number (cadr res)) (begin (debug:print 2 *default-log-port* "WARNING: Failed to process " dbfile " for run-id") 0)))) changed)))) ;; Get all targets from the db ;; (define (db:get-targets dbstruct) (let* ((res '()) (keys (db:get-keys dbstruct)) (header keys) ;; (map key:get-fieldname keys)) |
︙ | ︙ | |||
4110 4111 4112 4113 4114 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 | ;;====================================================================== ;; Just for sync, procedures to make sync easy ;;====================================================================== ;; get an alist of run ids and test/run, test_step/run pairs changed since time since-time ;; '((runs . (1 2 3 ...))(tests . ((5 . 1) (6 . 3) (6 . 2) (7 . 1) ... ;; (define (db:get-changed-record-ids dbstruct since-time) ;; no transaction, allow the db to be accessed between the big queries (let* ((backcons (lambda (lst item)(cons item lst))) (all_tests '()) (all_test_steps '()) (all_test_data '()) (changed_run_dbs (db:get-changed-run-ids since-time)) ;; gets the rundb numbers (all_run_ids (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:fold-row backcons '() db "SELECT id FROM runs")) ) ) (changed_run_ids (filter (lambda (run) (member (modulo run 100) changed_run_dbs)) all_run_ids)) (run_ids (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:fold-row backcons '() db "SELECT id FROM runs WHERE last_update>=?" since-time)) ) ) (run_stat_ids | > > > > > > > > > > > > > > > > | 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 | ;;====================================================================== ;; Just for sync, procedures to make sync easy ;;====================================================================== ;; get an alist of run ids and test/run, test_step/run pairs changed since time since-time ;; '((runs . (1 2 3 ...))(tests . ((5 . 1) (6 . 3) (6 . 2) (7 . 1) ... ;; Retrieves record IDs from the database based on the timestamp of their last update. ;; The function takes two arguments: dbstruct, which represents the database structure, and since-time, which is a timestamp indicating the time of the last update. ;; The function first defines a few helper functions, including backcons, which takes a list and an item and adds the item to the front of the list. ;; It then initializes several variables to empty lists: all_tests, all_test_steps, all_test_data, all_run_ids, and all_test_ids. ;; The function then retrieves a list of IDs for runs that have been changed since since-time using the db:get-changed-run-ids function. ;; It then filters the full list of run IDs to only include those that match the changed run IDs based on their modulo 100. ;; For each changed run ID, the function retrieves a list of test IDs, test step IDs, and test data IDs that have been updated since since-time. ;; It appends these IDs to the appropriate lists (all_tests, all_test_steps, and all_test_data) using the append and map functions. ;; The function then retrieves a list of run stat IDs that have been updated since since-time. ;; Finally, the function returns a list of associations between record types and their corresponding IDs: runs, tests, test_steps, test_data, and run_stats. ;; (define (db:get-changed-record-ids dbstruct since-time) ;; no transaction, allow the db to be accessed between the big queries (let* ((backcons (lambda (lst item)(cons item lst))) (all_tests '()) (all_test_steps '()) (all_test_data '()) (changed_run_dbs (db:get-changed-run-ids since-time)) ;; gets the rundb numbers (all_run_ids (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:fold-row backcons '() db "SELECT id FROM runs")) ) ) (changed_run_ids (filter (lambda (run) (member (modulo run 100) changed_run_dbs)) all_run_ids)) ;; TODO: couldn't we just use changed_run_ids for run_ids? (run_ids (db:with-db dbstruct #f #f (lambda (dbdat db) (sqlite3:fold-row backcons '() db "SELECT id FROM runs WHERE last_update>=?" since-time)) ) ) (run_stat_ids |
︙ | ︙ |
Modified dbfile.scm from [3c8c0eb1a6] to [a0af280a11].
︙ | ︙ | |||
30 31 32 33 34 35 36 37 38 39 40 41 42 43 | data-structures extras matchable) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-1 srfi-69 stack files ports commonmod ) | > | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | data-structures extras matchable) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-1 srfi-69 srfi-19 stack files ports commonmod ) |
︙ | ︙ | |||
504 505 506 507 508 509 510 | ;; (define (db:lock-and-delta-sync no-sync-db dbstruct from-db-file runid keys dbinit) (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.") ;; (dbfile:print-err *default-log-port* "db:lock-and-delta-sync") (let* ((lock-file (conc from-db-file ".lock"))) (if (common:simple-file-lock lock-file) (begin | | | | 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 | ;; (define (db:lock-and-delta-sync no-sync-db dbstruct from-db-file runid keys dbinit) (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.") ;; (dbfile:print-err *default-log-port* "db:lock-and-delta-sync") (let* ((lock-file (conc from-db-file ".lock"))) (if (common:simple-file-lock lock-file) (begin (dbfile:print-err "INFO: db:lock-and-delta-sync copying db " from-db-file ".db at "(date->string (seconds->date (current-seconds)))) (set! *db-sync-in-progress* #t) (db:sync-touched dbstruct runid keys dbinit) (set! *db-sync-in-progress* #f) (delete-file* lock-file) #t) (begin (dbfile:print-err "INFO: could not get lock for " from-db-file ".db, sync likely in progress.") #f )))) ;; ;; Get a lock from the no-sync-db for the from-db, then delta sync the from-db to the to-db, otherwise return #f ;; ;; ;; (define (db:lock-and-delta-sync-orig no-sync-db dbstruct from-db-file runid keys dbinit) ;; (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.") |
︙ | ︙ | |||
554 555 556 557 558 559 560 561 562 563 564 565 566 567 | (tmpdbfile (dbr:subdb-tmpdbfile subdb)) (mtdb (dbr:subdb-mtdbdat subdb)) (tmpdb (db:open-db dbstruct run-id dbinit)) ;; sqlite3-db tmpdbfile #f)) (start-t (current-seconds))) (mutex-lock! *db-multi-sync-mutex*) (let ((update_info (cons "last_update" (if force-sync 0 *db-last-sync*) ))) (mutex-unlock! *db-multi-sync-mutex*) (db:sync-tables (db:sync-all-tables-list dbstruct keys) update_info tmpdb mtdb)) (mutex-lock! *db-multi-sync-mutex*) (set! *db-last-sync* start-t) (set! *db-last-access* start-t) (mutex-unlock! *db-multi-sync-mutex*) (dbfile:add-dbdat dbstruct run-id tmpdb) #t)) | > | 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 | (tmpdbfile (dbr:subdb-tmpdbfile subdb)) (mtdb (dbr:subdb-mtdbdat subdb)) (tmpdb (db:open-db dbstruct run-id dbinit)) ;; sqlite3-db tmpdbfile #f)) (start-t (current-seconds))) (mutex-lock! *db-multi-sync-mutex*) (let ((update_info (cons "last_update" (if force-sync 0 *db-last-sync*) ))) (mutex-unlock! *db-multi-sync-mutex*) (dbfile:print-err "db:sync-touched: calling db:sync-tables with last_update = "*db-last-sync*) (db:sync-tables (db:sync-all-tables-list dbstruct keys) update_info tmpdb mtdb)) (mutex-lock! *db-multi-sync-mutex*) (set! *db-last-sync* start-t) (set! *db-last-access* start-t) (mutex-unlock! *db-multi-sync-mutex*) (dbfile:add-dbdat dbstruct run-id tmpdb) #t)) |
︙ | ︙ | |||
662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 | '("tags" #f) '("jobgroup" #f))))) (define (db:sync-all-tables-list dbstruct keys) (append (db:sync-main-list dbstruct keys) db:sync-tests-only)) ;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) ) ;; db's are dbdat's ;; ;; 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 . slave-dbs) (handle-exceptions exn (begin (dbfile:print-err "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.") (print-call-chain (current-error-port)) | > > > > > | 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 | '("tags" #f) '("jobgroup" #f))))) (define (db:sync-all-tables-list dbstruct keys) (append (db:sync-main-list dbstruct keys) db:sync-tests-only)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) ) ;; db's are dbdat's ;; ;; if last-update specified ("field-name" . time-in-seconds) ;; then sync only records where field-name >= time-in-seconds ;; IFF field-name exists ;;slave-dbs are an optional list of other dbs to sync to. ;;I only see this used in one place, in db:tmp->megatest.db-sync, with refndb, which is now obsolete. ;;TODO: resolve the above issue. ;; (define (db:sync-tables tbls last-update fromdb todb . slave-dbs) (handle-exceptions exn (begin (dbfile:print-err "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.") (print-call-chain (current-error-port)) |
︙ | ︙ | |||
689 690 691 692 693 694 695 | (if #t ;; (not (db:repair-db dbdat)) (begin (dbfile:print-err "Failed to rebuild (repair is turned off) " dbpath ", exiting now.") (exit))))) (cons todb slave-dbs)) 0) | | | > > > | | 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 | (if #t ;; (not (db:repair-db dbdat)) (begin (dbfile:print-err "Failed to rebuild (repair is turned off) " dbpath ", exiting now.") (exit))))) (cons todb slave-dbs)) 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Check fromdb, todb and the slave dbs. (cond ((not fromdb) (dbfile:print-err "WARNING: db:sync-tables called with fromdb missing") -1) ((not todb) (dbfile:print-err "WARNING: db:sync-tables called with todb missing") -2) ((not (sqlite3:database? (dbr:dbdat-dbh fromdb))) (dbfile:print-err "db:sync-tables called with fromdb not a database " fromdb) -3) ((not (sqlite3:database? (dbr:dbdat-dbh todb))) (dbfile:print-err "db:sync-tables called with todb not a database " todb) -4) ((not (file-write-access? (dbr:dbdat-dbfile todb))) (dbfile:print-err "db:sync-tables called with todb not a read-only database " todb) -5) ;; Make sure the optional slave dbs are not readonly. ((not (null? (let ((readonly-slave-dbs (filter (lambda (dbdat) (not (file-write-access? (dbr:dbdat-dbfile todb)))) slave-dbs))) (for-each (lambda (bad-dbdat) (dbfile:print-err "db:sync-tables called with todb not a read-only database " bad-dbdat)) readonly-slave-dbs) readonly-slave-dbs))) -6) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (else ;; args are good") (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 |
︙ | ︙ | |||
866 867 868 869 870 871 872 873 874 875 876 877 878 879 | (if (member "last_update" field-names) (db:create-trigger db tablename)))) (append (list todb) slave-dbs) ) ) ) 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. (for-each (lambda (dat) (let ((tblname (car dat)) (count (cdr dat))) | > > | 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 | (if (member "last_update" field-names) (db:create-trigger db tablename)))) (append (list todb) slave-dbs) ) ) ) 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. (for-each (lambda (dat) (let ((tblname (car dat)) (count (cdr dat))) |
︙ | ︙ |
Modified tasks.scm from [0f38bdbcce] to [8f38efeeb9].
︙ | ︙ | |||
734 735 736 737 738 739 740 | (if (equal? (args:get-arg "-dumpmode") "json") (task:print-testtime-as-json test-times) (if (equal? (args:get-arg "-dumpmode") "csv") (task:print-testtime test-times ",") (task:print-testtime test-times " "))))) | | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | 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 779 780 781 782 783 | (if (equal? (args:get-arg "-dumpmode") "json") (task:print-testtime-as-json test-times) (if (equal? (args:get-arg "-dumpmode") "csv") (task:print-testtime test-times ",") (task:print-testtime test-times " "))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; gets mtpg-run-id and syncs the record if different ;; ;; This function takes parameters including a database handle (dbh), cached information (cached-info), a run ID (run-id), area information (area-info), and the smallest last update time (smallest-last-update-time). ;; The function first tries to retrieve information about the given run ID from the cached information. If it is already cached, the function returns the cached information. ;; Otherwise, the function retrieves information about the run from the megatest database using various functions such as "rmt:get-run-info" and "db:get-value-by-header". ;; The function then uses this retrieved information to create a new run in the pgdb database, or update an existing one, using functions such as "pgdb:get-ttype", "pgdb:get-run-id", and "pgdb:insert-run". ;; It also sets various fields such as "state", "status", "owner", and "event_time". ;; The smallest-last-update-time variable is a single item hash table that is used to keep track of the smallest (earliest) "last_update" time among all the runs that are processed by calls to this function. ;; The "last_update" time is obtained from the megatest database for each run that needs to be processed. Then, if the "last_update" time for a particular run is greater (later) than the "last_update" time of the ;; corresponding run in the PostgreSQL database, the "last_update" time of that run is stored in the "smallest-last-update-time" hash table. ;; This is done to ensure that only the runs that have been updated since the last time the synchronization was performed are updated in the PostgreSQL database. This is because updating all the runs, even those ;; that have not been modified since the last synchronization, can be a time-consuming process. ;; At the end of the function, if a new run is successfully inserted into the PostgreSQL database, the "last_update" time of that run is compared with the current value of "smallest-time" in the "smallest-last-update-time" ;; hash table. If the "last_update" time is smaller than the current value of "smallest-time" or if "smallest-time" does not exist, "last_update" time is stored as the new "smallest-time". This ensures that the smallest ;; "last_update" time among all the runs processed by the function is always stored in the "smallest-last-update-time" hash table. ;; The smallest-last-update-time hash is referenced in calling functions and is used in the call to "pgdb:write-sync-time dbh area-info smallest-time" in tasks:sync-to-postgres. ;; If a new entry was successfully created or updated, the function returns the ID of the new entry. If there was an error, the function returns false. (define (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time) (let* ((runs-ht (hash-table-ref cached-info 'runs)) (runinf (hash-table-ref/default runs-ht run-id #f)) (area-id (vector-ref area-info 0))) (if runinf runinf ;; already cached (let* ((run-dat (rmt:get-run-info run-id)) ;; NOTE: get-run-info returns a vector < row header > (run-name (rmt:get-run-name-from-id run-id)) (row (db:get-rows run-dat)) ;; yes, this returns a single row (header (db:get-header run-dat)) (state (db:get-value-by-header row header "state")) (status (db:get-value-by-header row header "status")) (owner (db:get-value-by-header row header "owner")) (event-time (db:get-value-by-header row header "event_time")) |
︙ | ︙ | |||
775 776 777 778 779 780 781 | (target (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) (conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) base-target) base-target)) ;; e.g. v1.63/a3e1/ubuntu (spec-id (pgdb:get-ttype dbh keytarg)) (publish-time (if (args:get-arg "-cp-eventtime-to-publishtime") event-time (current-seconds))) (new-run-id (if (and run-name base-target) (pgdb:get-run-id dbh spec-id target run-name area-id) #f))) | | | | | | | | | < < < > | | | | > | | > | | | | | | | | | < | > | | | > > > | > | > > > > > > > | 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 | (target (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) (conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) base-target) base-target)) ;; e.g. v1.63/a3e1/ubuntu (spec-id (pgdb:get-ttype dbh keytarg)) (publish-time (if (args:get-arg "-cp-eventtime-to-publishtime") event-time (current-seconds))) (new-run-id (if (and run-name base-target) (pgdb:get-run-id dbh spec-id target run-name area-id) #f))) (if new-run-id (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id)) (hash-table-set! runs-ht run-id new-run-id) ;; ensure key fields are up to date ;; if last_update == pgdb_last_update do not update smallest-last-update-time (let* ((pgdb-last-update (pgdb:get-run-last-update dbh new-run-id)) (smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f))) (if (and (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time))) (hash-table-set! smallest-last-update-time "smallest-time" last-update)) ) (pgdb:refresh-run-info dbh new-run-id state status owner event-time comment fail-count pass-count area-id last-update publish-time) (debug:print-info 4 *default-log-port* "Working on run-id " run-id " pgdb-id " new-run-id ) (if (not (equal? run-tag "")) (task:add-run-tag dbh new-run-id run-tag) ) new-run-id ) ;; if no pgdb run id was found (if (or (not state) (equal? state "deleted")) (begin (debug:print-info 1 *default-log-port* "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f) (if (handle-exceptions exn (begin (print-call-chain) (debug:print 0 *default-log-port* ((condition-property-accessor 'exn 'message) exn)) #f ) (pgdb:insert-run dbh spec-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time) ) (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" #f))) (if (or (not smallest-time) (< last-update smallest-time)) (hash-table-set! smallest-last-update-time "smallest-time" last-update) ) ;; call this function recursively to get the pgdb run id ;; TODO: Why not just call pgdb:get-run-id here to get the id? (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time) ) #f ) ) ) ) ) ) ) (define (task:add-run-tag dbh run-id tag) (let* ((tag-info (pgdb:get-tag-info-by-name dbh tag))) (if (not tag-info) (begin (if (handle-exceptions exn |
︙ | ︙ | |||
944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 | (hash-table-set! data-ht data-id pgdb-data-id )) (begin (debug:print-info 1 *default-log-port* "Error: Test not in pgdb")))) (debug:print-info 1 *default-log-port* "Error: Could not get test data info for data id " test-data-id )))) ;; this is a wierd senario need to debug test-data-ids))) (define (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) (let ((test-ht (hash-table-ref cached-info 'tests)) (run-id-in #f)) (for-each (lambda (test-id) (set! run-id-in (cdr test-id)) | > > > > > > > > > > > > > > > > > > | 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 | (hash-table-set! data-ht data-id pgdb-data-id )) (begin (debug:print-info 1 *default-log-port* "Error: Test not in pgdb")))) (debug:print-info 1 *default-log-port* "Error: Could not get test data info for data id " test-data-id )))) ;; this is a wierd senario need to debug test-data-ids))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This function synchronizes test data between the megatest db and the pgdb. It takes several parameters, including a pgdb database handle (dbh), ;; a hash table of cached information (cached-info), a list of test IDs (test-ids), and other data related to the specific area being synced (area-info and smallest-last-update-time). ;; The function first retrieves the cached test hash table (test-ht) from cached-info and sets the run-id-in variable to false. It then iterates over each test ID in test-ids using ;; a for-each loop. Within the loop, it sets run-id-in to the second element of the test ID pair (which is assumed to be a cons cell), and sets test-id to the first element of the pair. ;; The function then uses rmt:get-test-info-by-id to retrieve information about the test specified by run-id-in and test-id. It extracts various properties from this ;; information, such as the run-id, test-name, item-path, state, status, host, and so on. ;; If item-path is null or empty, the function prints a message to the log. Otherwise, it checks if pgdb-run-id is truthy, meaning that a corresponding test record was found in the ;; remote database. If pgdb-test-id is also truthy, it means that the test record exists in the remote database and needs to be updated. If pgdb-test-id is falsey, it means that the ;; test record needs to be inserted into the remote database. ;; If the last-update timestamp of the local test record is greater than the last-update timestamp of the remote test record, the function updates the remote test record with the new ;; data. If the last-update timestamp is less than or equal to the smallest-time value in smallest-last-update-time, the function updates the smallest-time value to the new last-update ;; timestamp. If the remote test record does not exist, the function inserts a new test record into the remote database. ;; After each test ID is processed, the function updates the test-ht hash table with the corresponding pgdb-test-id. (define (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) (let ((test-ht (hash-table-ref cached-info 'tests)) (run-id-in #f)) (for-each (lambda (test-id) (set! run-id-in (cdr test-id)) |
︙ | ︙ | |||
988 989 990 991 992 993 994 | ;; "id" "run_id" "testname" "state" "status" "event_time" ;; "host" "cpuload" "diskfree" "uname" "rundir" "item_path" ;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived" (if (or (not item-path) (string-null? item-path)) (debug:print-info 0 *default-log-port* "Working on Run id : " run-id " and test name : " test-name)) (if pgdb-run-id (begin | | | | | | | > > | > | | | | | > | > > | | > > > | > > > > | 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 | ;; "id" "run_id" "testname" "state" "status" "event_time" ;; "host" "cpuload" "diskfree" "uname" "rundir" "item_path" ;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived" (if (or (not item-path) (string-null? item-path)) (debug:print-info 0 *default-log-port* "Working on Run id : " run-id " and test name : " test-name)) (if pgdb-run-id (begin (if pgdb-test-id ;; have a record (begin ;; let ((key-name (conc run-id "/" test-name "/" item-path))) (debug:print-info 4 *default-log-port* "Updating existing test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id " pgdb-test-id " pgdb-test-id) (let* ((pgdb-last-update (pgdb:get-test-last-update dbh pgdb-test-id))) (if (and (> last-update pgdb-last-update) (or (not smallest-time) (< last-update smallest-time))) ;;if last-update is same as pgdb-last-update then it is safe to assume the records are identical and we can use a larger last update time. (hash-table-set! smallest-last-update-time "smallest-time" last-update) ) ) (pgdb:update-test dbh pgdb-test-id pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update pid) ) (begin (debug:print-info 4 *default-log-port* "Inserting test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id) (pgdb:insert-test dbh pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update pid) (if (or (not smallest-time) (< last-update smallest-time)) (hash-table-set! smallest-last-update-time "smallest-time" last-update) ) (set! pgdb-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path)) ) ) (hash-table-set! test-ht test-id pgdb-test-id)) (debug:print-info 1 *default-log-port* "WARNING: Skipping run with run-id:" run-id ". This run was created after previous sync and removed before this sync.") ) ) ) test-ids ) ) ) (define (task:add-area-tag dbh area-info tag) (let* ((tag-info (pgdb:get-tag-info-by-name dbh tag))) (if (not tag-info) (begin (if (handle-exceptions exn |
︙ | ︙ | |||
1034 1035 1036 1037 1038 1039 1040 | (for-each (lambda (run-id) (debug:print-info 4 *default-log-port* "Check if run with " run-id " needs to be synced" ) (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time)) run-ids)) | > > | > | > > > > > > > | > > > > > > > > > > > > > < | 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 | (for-each (lambda (run-id) (debug:print-info 4 *default-log-port* "Check if run with " run-id " needs to be synced" ) (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info smallest-last-update-time)) run-ids)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This function takes two arguments "configdat" and "dest". The purpose of this function is to synchronize data from a source database to a PostgreSQL database. ;; Here's what this function does: ;; Opens a connection to the PostgreSQL database using the "pgdb:open" function. ;; Retrieves information about the last sync of *toppath*, using pgdb:get-area-by-path, and stores it in the "area-info" vector variable. (id, area_name, area_path, last_sync) ;; Creates a hash table named "cached-info" which will contain a start time, and megatest to pgdb ID mapping tables for runs, targets, tests, steps, and data. The targets table does not seem to be used. (TODO: remove it?) ;; Checks if the user has provided EITHER both the "target" and "run-name" arguments or NEITHER. If not, it prints an error message and exits. ;; Sets the "start" variable to the current time. ;; Creates hash tables for five data types: runs, targets, tests, steps, and data, and enters them in the cached-info table.. ;; Sets the "start" time in the "cached-info" hash table. ;; If area-info was found, ;; Retrieves the last synchronization time from the area-info vector or from the megatest "-since" argument. ;; Creates the smallest-last-update-time hash table. ;; Retrieves records that have been changed since the last synchronization time using the "rmt:get-changed-record-ids" or "rmt:get-run-record-ids" function, depending on whether the user has provided the "-target" and "-runname" arguments. ;; Retrieves the IDs of runs, tests, test steps, test data, and run stats that have been changed. ;; Retrieves the area tag from the user-provided "-area-tag" or "-area" argument or sets it to the default area tag. ;; Adds the area tag to the area record in the PostgreSQL database. ;; synchronizes the runs, tests, test steps, and test data using their respective "tasks:sync-" functions. ;; Writes the synchronization time to the PostgreSQL database from smallest-last-update-time.. ;; If the area info was not found, it sets the area using tasks:set-area. ;; If the "tasks:set-area" function returns true, the "tasks:sync-to-postgres" function is called again recursively. Otherwise, an error message is printed and the function returns false. ;; TODO: just set the area-info when it is not found, instead of doing recursion here. (define (tasks:sync-to-postgres configdat dest) (let* ((dbh (pgdb:open configdat dbname: dest)) (area-info (pgdb:get-area-by-path dbh *toppath*)) (cached-info (make-hash-table)) (start (current-seconds)) (test-patt (if (args:get-arg "-testpatt") (args:get-arg "-testpatt") "%")) |
︙ | ︙ | |||
1061 1062 1063 1064 1065 1066 1067 | (begin (debug:print 0 *default-log-port* "Error: Provide runname") (exit 1))) (if (and (not target) run-name) (begin (debug:print 0 *default-log-port* "Error: Provide target") (exit 1))) | < < > > > > > | | | | | > > > > > > > | | > > > > | 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 | (begin (debug:print 0 *default-log-port* "Error: Provide runname") (exit 1))) (if (and (not target) run-name) (begin (debug:print 0 *default-log-port* "Error: Provide target") (exit 1))) (for-each (lambda (dtype) (hash-table-set! cached-info dtype (make-hash-table))) '(runs targets tests steps data)) (hash-table-set! cached-info 'start start) ;; when done we'll set sync times to this (if area-info (let* ((last-sync-time (if (args:get-arg "-since") (string->number (args:get-arg "-since")) (vector-ref area-info 3))) (smallest-last-update-time (make-hash-table)) (changed (if (and target run-name) (rmt:get-run-record-ids target run-name (rmt:get-keys) test-patt) (rmt:get-changed-record-ids last-sync-time))) (run-ids (alist-ref 'runs changed)) (test-ids (alist-ref 'tests changed)) (test-step-ids (alist-ref 'test_steps changed)) (test-data-ids (alist-ref 'test_data changed)) (run-stat-ids (alist-ref 'run_stats changed)) (area-tag (if (args:get-arg "-area-tag") (args:get-arg "-area-tag") (if (args:get-arg "-area") (args:get-arg "-area") "")))) (debug:print-info 0 *default-log-port* "changed records since " (time->string (seconds->local-time last-sync-time) "%m/%d %H:%M") ": " changed) (debug:print-info 0 *default-log-port* "last sync time: " last-sync-time) (if (and (equal? area-tag "") (not (pgdb:is-area-taged dbh (vector-ref area-info 0)))) (set! area-tag *default-area-tag*)) (if (not (equal? area-tag "")) (task:add-area-tag dbh area-info area-tag)) (if (not (null? run-ids)) (begin (debug:print-info 0 *default-log-port* "syncing runs: " run-ids) (tasks:sync-run-data dbh cached-info run-ids area-info smallest-last-update-time) ) ) (if (not (null? test-ids)) (begin (debug:print-info 0 *default-log-port* "syncing tests: " test-ids) (tasks:sync-tests-data dbh cached-info test-ids area-info smallest-last-update-time) (debug:print-info 0 *default-log-port* "syncing test steps") (tasks:sync-test-steps dbh cached-info test-step-ids smallest-last-update-time) (debug:print-info 0 *default-log-port* "syncing test data") (tasks:sync-test-gen-data dbh cached-info test-data-ids smallest-last-update-time) ) ) (let* ((smallest-time (hash-table-ref/default smallest-last-update-time "smallest-time" (current-seconds)))) (debug:print-info 0 "smallest-time :" smallest-time " last-sync-time " last-sync-time) (if (not (and target run-name)) (if (or (and smallest-time (> smallest-time last-sync-time)) (and smallest-time (eq? last-sync-time 0))) (pgdb:write-sync-time dbh area-info smallest-time)) ) ) ) ;;this needs to be changed ;; If the area info was not found in the the areas table, set it and repeat tasks:sync-to-postgres. ;; TODO: why not just set the area info when it is not found rather than do recursion? (if (tasks:set-area dbh configdat) (tasks:sync-to-postgres configdat dest) (begin (debug:print 0 *default-log-port* "ERROR: unable to create an area record") #f) ) ) ) ) |