Random Bits of Open Code

Check-in [7ac36960b6]
Login

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

Overview
Comment:Capture area-ids into adat structs
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:7ac36960b674ccda2be9283f401b1b1064484bbc
User & Date: matt 2018-05-01 07:36:59
Context
2018-05-01
23:44
Added get-mindata check-in: ef7a0d02fc user: matt tags: trunk
07:36
Capture area-ids into adat structs check-in: 7ac36960b6 user: matt tags: trunk
2018-04-30
06:03
Added get-runs-info check-in: 7e6abd32c5 user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to mtutils/adat.scm.

15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31
32
33

34
35
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(defstruct adat

  (name              #f)
  (path              #f)
  (last-refresh      0)
  (last-db-timestamp 0)
  (mtconfig          #f)
  (runconfig         #f)
  (tmppath           #f)
  (mtdb-main         #f)
  (mtdb-runs         (make-hash-table)) ;; run-id -> dbhandle
  (mtdb              #f) ;; megatest.db
  (common-db         #f)
  (tmp-area          #f) ;; this is the parent area to path

  )








>









|


>


15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(defstruct adat
  (id                #f) ;; area id from database
  (name              #f)
  (path              #f)
  (last-refresh      0)
  (last-db-timestamp 0)
  (mtconfig          #f)
  (runconfig         #f)
  (tmppath           #f)
  (mtdb-main         #f)
  (mtdb-runs         (make-hash-table)) ;; run-id -> dbhandle
  (mtdb              #f)
  (common-db         #f)
  (tmp-area          #f) ;; this is the parent area to path
  (area-ok           #f) ;; the source area contains valid megatest.db, megatest.config and runconfigs.config files.
  )

Changes to mtutils/mtdb/mtdb.scm.

501
502
503
504
505
506
507
508


509
510
511
512
513
514
515
516

517
518
519
520
521
522
523
....
1157
1158
1159
1160
1161
1162
1163
1164


1165
1166
1167
1168
1169
1170
1171

(define (get-run-name-from-id dbh run-id)
  (dbi:get-one
   dbh
   "SELECT runname FROM runs WHERE id=?;"
   run-id))

;; given a run-id return all the run info


;;
(define (get-runs-info dbh target-patt run-name-patt area-patt) ;; to join ttype or not?
  (dbi:fold-row
   cons
   '()
   dbh   ;; 0    1       2       3      4     5      6       7        8         9         10          11         12
   "SELECT id,target,ttype_id,run_name,state,status,owner,event_time,comment,fail_count,pass_count,last_update,area_id
       FROM runs WHERE target LIKE ? AND run_name LIKE ? AND area_id IN (SELECT id FROM areas WHERE area_name LIKE ?);"

   target-patt run-name-patt area-patt))

;;======================================================================
;;  T E S T - S T E P S
;;======================================================================

(define (get-test-step-id dbh test-id stepname state)
................................................................................
	 (else 
	  (let* ((last-sync-time (vector-ref area-info 3))
		 (changed        (get-changed-record-ids adat1 last-sync-time))
		 (run-ids        (or (alist-ref 'runs       changed) '()))
		 (test-ids       (or (alist-ref 'tests      changed) '()))
		 (test-step-ids  (or (alist-ref 'test_steps changed) '()))
		 (test-data-ids  (or (alist-ref 'test_data  changed) '()))
		 (run-stat-ids   (or (alist-ref 'run_stats  changed) '())))


	    (print "num run-ids: " (length run-ids) " num test-ids: " (length test-ids))
	    ;; sync run records
	    (for-each
	     (lambda (mt-run-id)
	       (run-id->mtpg-run-id adat1 adat2 cached-info mt-run-id area-info))
	     run-ids)
	    ;; record the tag info







|
>
>







|
>







 







|
>
>







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
....
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176

(define (get-run-name-from-id dbh run-id)
  (dbi:get-one
   dbh
   "SELECT runname FROM runs WHERE id=?;"
   run-id))

;; given patterns for target, run-name and area, return all runs info
;;
;;  (use mtdb)(define adat (make-adat name: "foo" path: "/mfs/home/matt/data/megatest/ext-tests"))(adat-init adat "/mfs/home/matt/data/megatest/ext-tests")(with-common-db adat (lambda (dbh)(length (get-runs-info dbh "%" "%" "%"))))
;;
(define (get-runs-info dbh target-patt run-name-patt area-patt) ;; to join ttype or not?
  (dbi:fold-row
   cons
   '()
   dbh   ;; 0    1       2       3      4     5      6       7        8         9         10          11         12
   "SELECT id,target,ttype_id,run_name,state,status,owner,event_time,comment,fail_count,pass_count,last_update,area_id
       FROM runs WHERE target LIKE ? AND run_name LIKE ? AND area_id IN (SELECT id FROM areas WHERE area_name LIKE ?)
       ORDER BY event_time DESC, id DESC;"
   target-patt run-name-patt area-patt))

;;======================================================================
;;  T E S T - S T E P S
;;======================================================================

(define (get-test-step-id dbh test-id stepname state)
................................................................................
	 (else 
	  (let* ((last-sync-time (vector-ref area-info 3))
		 (changed        (get-changed-record-ids adat1 last-sync-time))
		 (run-ids        (or (alist-ref 'runs       changed) '()))
		 (test-ids       (or (alist-ref 'tests      changed) '()))
		 (test-step-ids  (or (alist-ref 'test_steps changed) '()))
		 (test-data-ids  (or (alist-ref 'test_data  changed) '()))
		 (run-stat-ids   (or (alist-ref 'run_stats  changed) '()))
		 (area-id        (vector-ref area-info 0)))
	    (if (not (adat-id adat2))(adat-id-set! adat2 area-id))
	    (print "num run-ids: " (length run-ids) " num test-ids: " (length test-ids))
	    ;; sync run records
	    (for-each
	     (lambda (mt-run-id)
	       (run-id->mtpg-run-id adat1 adat2 cached-info mt-run-id area-info))
	     run-ids)
	    ;; record the tag info