Random Bits of Open Code

Check-in [10e54d0c7e]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fixed problem where using adat1 run-id where needed adat2 run-id, added ability to continue sync.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:10e54d0c7e052e17c96f57479afbd6965f163131
User & Date: matt 2018-05-06 05:01:30
Context
2018-05-06
10:11
wrong db handle used in database init. check-in: 7ed7a603cd user: matt tags: trunk
05:01
Fixed problem where using adat1 run-id where needed adat2 run-id, added ability to continue sync. check-in: 10e54d0c7e user: matt tags: trunk
2018-05-04
23:09
Added debug stuff check-in: fe6adf7d20 user: mrwellan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to mtutils/mtdb/mtdb.scm.

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
293
294
295
296
297
298
299
300

301
302
303
304
305
306
307
....
1078
1079
1080
1081
1082
1083
1084
1085
1086

1087
1088


1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
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
     get-last-run-version-number
     set-last-run-version
 
     )

(import scheme chicken data-structures extras ports srfi-69 srfi-1)
(use regex srfi-13 matchable
     ;; (prefix sql-de-lite s:)
     (prefix sqlite3 s:)
     (prefix dbi dbi:) posix typed-records
     (prefix mtcommon common:)
     (prefix mtconfigf configf:))

;; (use trace)

(define *default-log-port* (current-error-port))
................................................................................
        #f)))

;; open and if needed init a sqlite3 db with the schema
;; 
(define (mtdb-sqlite3-open path fbase)
  (let* ((fulln   (conc path "/" fbase ".db"))
	 (fexists (file-exists? fulln))
	 (dbtype  'sqlite3) ;; 'sql-de-lite

	 (dbispec `((dbname . ,fulln)))
	 (dbh     (dbi:open dbtype dbispec))
	 (db      (dbi:db-conn dbh)))
    ;; WARNING: Race condition exists here.
       (if (not fexists)
	   (dbi:with-transaction
	    dbh
................................................................................
	  (hash-table-set! tinfo-cache test-id (get-test-info-by-id mt-dbh test-id)))
	test-ids)))

    (set! run-ids (delete-duplicates (map (lambda (tdat)(vector-ref tdat 1)) (hash-table-values tinfo-cache))))

    (for-each
     (lambda (run-id)
       (let* ((start-time (current-seconds))
	      (tests     (filter (lambda (t)(eq? run-id (vector-ref t 1)))(hash-table-values tinfo-cache)))

	      (run-dbh   (with-run-db adat2 #f run-id)))
	 (print "INFO: filtering took " (- (current-seconds) start-time) " seconds. Now syncing " (length tests) " for run " run-id)


	 (dbi:with-transaction
	  run-dbh
	  (lambda ()
	    (for-each
	     (lambda (test-info)
	       (match-let
		(((test-id  run-id    test-name  state    status     event-time    host     cpuload
			    diskfree  uname      run-dir  item-path  run-duration  log-file comment shortdir attemptnum archived)
		  (vector->list test-info)))
		(print "INFO: updating/creating record for test with id " test-id " and test name " test-name)
		(let* ((pgdb-run-id  (run-id->mtpg-run-id adat1 adat2 cached-info run-id area-info))
		       (pgdb-test-id (if pgdb-run-id 
					 (begin
					   (get-test-id adat2 pgdb-run-id test-name item-path))
					 #f)))
		  ;; "id"           "run_id"        "testname"  "state"      "status"      "event_time"
		  ;; "host"         "cpuload"       "diskfree"  "uname"      "rundir"      "item_path"
		  ;; "run_duration" "final_logf"    "comment"   "shortdir"   "attemptnum"  "archived"
		  (if pgdb-run-id
		      (begin
			(if pgdb-test-id ;; have a record
			    (begin ;; let ((key-name (conc run-id "/" test-name "/" item-path)))
			      (print "Updating existing test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id)
			      (update-test run-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))
			    (begin 
			      (print "Inserting test with run-id: " run-id " and test-id: " test-id  " pgdb run id: " pgdb-run-id)
			      (insert-test run-dbh pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived)
			      (set! pgdb-test-id (get-test-id adat2 pgdb-run-id test-name item-path))))
			(hash-table-set! test-ht test-id pgdb-test-id))
		      (print "WARNING: Skipping run with run-id:" run-id ". This run was created after previous sync and removed before this sync.")))))
	     tests)))
	 (print "INFO: sync for run " run-id " completed in " (- (current-seconds) start-time) " seconds.")
	 ))
     run-ids)))

(use trace)(trace insert-test)(trace-call-sites #t)

(define (add-area-tag dbh area-info tag) 
  (let* ((tag-info (get-tag-info-by-name dbh tag)))
    (if (not tag-info)
	(begin   
	  (if (handle-exceptions
		  exn







|
|







 







|
>







 







|
|
>
|

>
>
|
|
|
|
|
|
|
|
|
|
<
|
|
|
|
|
|
|
<
<
|
|
|
|
|
|
|
|
|
<
|
|
<


|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
....
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
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
     get-last-run-version-number
     set-last-run-version
 
     )

(import scheme chicken data-structures extras ports srfi-69 srfi-1)
(use regex srfi-13 matchable
     (prefix sql-de-lite s:)
     ;; (prefix sqlite3 s:)
     (prefix dbi dbi:) posix typed-records
     (prefix mtcommon common:)
     (prefix mtconfigf configf:))

;; (use trace)

(define *default-log-port* (current-error-port))
................................................................................
        #f)))

;; open and if needed init a sqlite3 db with the schema
;; 
(define (mtdb-sqlite3-open path fbase)
  (let* ((fulln   (conc path "/" fbase ".db"))
	 (fexists (file-exists? fulln))
	 ;; (dbtype  'sqlite3) ;; 'sql-de-lite
	 (dbtype  'sql-de-lite)
	 (dbispec `((dbname . ,fulln)))
	 (dbh     (dbi:open dbtype dbispec))
	 (db      (dbi:db-conn dbh)))
    ;; WARNING: Race condition exists here.
       (if (not fexists)
	   (dbi:with-transaction
	    dbh
................................................................................
	  (hash-table-set! tinfo-cache test-id (get-test-info-by-id mt-dbh test-id)))
	test-ids)))

    (set! run-ids (delete-duplicates (map (lambda (tdat)(vector-ref tdat 1)) (hash-table-values tinfo-cache))))

    (for-each
     (lambda (run-id)
       (let* ((start-time   (current-seconds))
	      (tests        (filter (lambda (t)(eq? run-id (vector-ref t 1)))(hash-table-values tinfo-cache)))
	      (pgdb-run-id  (run-id->mtpg-run-id adat1 adat2 cached-info run-id area-info))
	      (run-dbh      (with-run-db adat2 #f pgdb-run-id)))
	 (print "INFO: filtering took " (- (current-seconds) start-time) " seconds. Now syncing " (length tests) " for run " run-id)
	 (if (not pgdb-run-id)
	     (print "WARNING: Skipping run with run-id:" run-id ". This run was created after previous sync and removed before this sync.")
	     (dbi:with-transaction
	      run-dbh
	      (lambda ()
		(for-each
		 (lambda (test-info)
		   (match-let
		       (((test-id  run-id    test-name  state    status     event-time    host     cpuload
				   diskfree  uname      run-dir  item-path  run-duration  log-file comment shortdir attemptnum archived)
			 (vector->list test-info)))
		     (print "INFO: updating/creating record for test with id " test-id " and test name " test-name)

		     (let* ((pgdb-test-id (if pgdb-run-id 
					      (begin
						(get-test-id adat2 pgdb-run-id test-name item-path))
					      #f)))
		       ;; "id"           "run_id"        "testname"  "state"      "status"      "event_time"
		       ;; "host"         "cpuload"       "diskfree"  "uname"      "rundir"      "item_path"
		       ;; "run_duration" "final_logf"    "comment"   "shortdir"   "attemptnum"  "archived"


		       (if pgdb-test-id ;; have a record
			   (begin ;; let ((key-name (conc run-id "/" test-name "/" item-path)))
			     (print "Updating existing test with run-id: " run-id " and test-id: " test-id " pgdb run id: " pgdb-run-id)
			     (update-test run-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))
			   (begin 
			     (print "Inserting test with run-id: " run-id " and test-id: " test-id  " pgdb run id: " pgdb-run-id)
			     (insert-test run-dbh pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived)
			     (set! pgdb-test-id (get-test-id adat2 pgdb-run-id test-name item-path))))
		       (hash-table-set! test-ht test-id pgdb-test-id))))

		 tests))))
	 (print "INFO: sync for run " run-id " completed in " (- (current-seconds) start-time) " seconds.")))

     run-ids)))

;; (use trace)(trace insert-test)(trace-call-sites #t)

(define (add-area-tag dbh area-info tag) 
  (let* ((tag-info (get-tag-info-by-name dbh tag)))
    (if (not tag-info)
	(begin   
	  (if (handle-exceptions
		  exn