| ︙ | | |
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
|
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
|
-
+
-
+
+
|
((none)(loop (conc (current-user-name) "_" area-name) 'user))
((user)(loop (conc (substring (common:get-area-path-signature) 0 4)
area-name) 'areasig))
(else #f)))))) ;; give up
;; gets mtpg-run-id and syncs the record if different
;;
(define (tasks:run-id->mtpg-run-id dbh cached-info run-id)
(define (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info)
(let* ((runs-ht (hash-table-ref cached-info 'runs))
(runinf (hash-table-ref/default runs-ht run-id #f)))
(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 "))
|
| ︙ | | |
645
646
647
648
649
650
651
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
|
646
647
648
649
650
651
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
|
-
+
-
+
-
-
+
+
|
db-contour
(args:get-arg "-contour"))))
(keytarg (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target"))
(conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform
(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) "/")) (rmt:get-target run-id)) (rmt:get-target run-id))) ;; e.g. v1.63/a3e1/ubuntu
(spec-id (pgdb:get-ttype dbh keytarg))
(new-run-id (pgdb:get-run-id dbh spec-id target run-name))
(new-run-id (pgdb:get-run-id dbh spec-id target run-name area-id))
;; (area-id (db:get-value-by-header row header "area_id)"))
)
(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
(pgdb:refresh-run-info
dbh
new-run-id
state status owner event-time comment fail-count pass-count)
state status owner event-time comment fail-count pass-count area-id)
new-run-id)
(if (handle-exceptions
exn
(begin (print-call-chain)
(print ((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))
(tasks:run-id->mtpg-run-id dbh cached-info run-id)
spec-id target run-name state status owner event-time comment fail-count pass-count area-id))
(tasks:run-id->mtpg-run-id dbh cached-info run-id area-info)
#f))))))
(define (tasks:sync-test-steps dbh cached-info test-step-ids)
(let ((test-ht (hash-table-ref cached-info 'tests))
(step-ht (hash-table-ref cached-info 'steps)))
(for-each
|
| ︙ | | |
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
|
708
709
710
711
712
713
714
715
716
717
718
719
720
721
|
-
|
(print "Error: Test not cashed")))
(print "Error: Could not get test step info for step id " test-step-id )))) ;; this is a wierd senario need to debug
test-step-ids)))
(define (tasks:sync-test-gen-data dbh cached-info test-data-ids)
(let ((test-ht (hash-table-ref cached-info 'tests))
(data-ht (hash-table-ref cached-info 'data)))
(print test-data-ids)
|
| ︙ | | |
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
|
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
|
-
+
-
+
|
(print "Error: Test not in pgdb"))))
(print "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)
(define (tasks:sync-tests-data dbh cached-info test-ids area-info)
(let ((test-ht (hash-table-ref cached-info 'tests)))
(for-each
(lambda (test-id)
(let* ((test-info (rmt:get-test-info-by-id #f test-id))
(run-id (db:test-get-run_id test-info)) ;; look these up in db_records.scm
(test-id (db:test-get-id test-info))
(test-name (db:test-get-testname test-info))
(item-path (db:test-get-item-path test-info))
(state (db:test-get-state test-info))
(status (db:test-get-status test-info))
(host (db:test-get-host test-info))
(cpuload (db:test-get-cpuload test-info))
(diskfree (db:test-get-diskfree test-info))
(uname (db:test-get-uname test-info))
(run-dir (db:test-get-rundir test-info))
(log-file (db:test-get-final_logf test-info))
(run-duration (db:test-get-run_duration test-info))
(comment (db:test-get-comment test-info))
(event-time (db:test-get-event_time test-info))
(archived (db:test-get-archived test-info))
(pgdb-run-id (tasks:run-id->mtpg-run-id dbh cached-info run-id))
(pgdb-run-id (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info))
(pgdb-test-id (if pgdb-run-id
(begin
;(print pgdb-run-id)
(pgdb:get-test-id dbh pgdb-run-id test-name item-path))
#f)))
;; "id" "run_id" "testname" "state" "status" "event_time"
|
| ︙ | | |
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
|
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
|
+
-
+
-
+
+
-
+
-
-
+
-
|
(changed (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)))
(print "area-info: " area-info)
(if (not (null? test-ids))
(begin
(print "Syncing " (length test-step-ids) " changed tests")
(tasks:sync-tests-data dbh cached-info test-ids)
(tasks:sync-tests-data dbh cached-info test-ids area-info)
;(exit)
(tasks:sync-test-steps dbh cached-info test-step-ids)
(tasks:sync-test-gen-data dbh cached-info test-data-ids)
(tasks:sync-test-gen-data dbh cached-info test-data-ids)))
))
;(pgdb:write-sync-time dbh area-info start)
)
|