| ︙ | | | ︙ | |
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
|
(owner (db:get-value-by-header row header "owner"))
(event-time (db:get-value-by-header row header "event_time"))
(comment (db:get-value-by-header row header "comment"))
(fail-count (db:get-value-by-header row header "fail_count"))
(pass-count (db:get-value-by-header row header "pass_count"))
(db-contour (db:get-value-by-header row header "contour"))
(contour (if (args:get-arg "-prepend-contour")
(if db-contour
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 area-id))
|
>
>
|
|
|
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
|
(owner (db:get-value-by-header row header "owner"))
(event-time (db:get-value-by-header row header "event_time"))
(comment (db:get-value-by-header row header "comment"))
(fail-count (db:get-value-by-header row header "fail_count"))
(pass-count (db:get-value-by-header row header "pass_count"))
(db-contour (db:get-value-by-header row header "contour"))
(contour (if (args:get-arg "-prepend-contour")
(if (and db-contour (not (equal? db-contour "")))
(begin
(print "db-contour")
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 area-id))
|
| ︙ | | | ︙ | |
783
784
785
786
787
788
789
790
791
792
793
794
795
796
|
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 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
(lambda (test-step-id)
(let* ((test-step-info (rmt:get-steps-info-by-id test-step-id))
(step-id (tdb:step-get-id test-step-info))
(test-id (tdb:step-get-test_id test-step-info))
|
>
|
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
|
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 area-info)
#f)))))))
(define (tasks:sync-test-steps dbh cached-info test-step-ids)
(print "Sync Steps " test-step-ids )
(let ((test-ht (hash-table-ref cached-info 'tests))
(step-ht (hash-table-ref cached-info 'steps)))
(for-each
(lambda (test-step-id)
(let* ((test-step-info (rmt:get-steps-info-by-id test-step-id))
(step-id (tdb:step-get-id test-step-info))
(test-id (tdb:step-get-test_id test-step-info))
|
| ︙ | | | ︙ | |
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
|
#f)))
(if step-id
(begin
(if pgdb-test-id
(begin
(if pgdb-step-id
(begin
(print "Updating existing test-step with test-id: " test-id " and step-id " step-id)
(pgdb:update-test-step dbh pgdb-step-id pgdb-test-id stepname state status event_time comment logfile))
(begin
(print "Inserting test-step with test-id: " test-id " and step-id " step-id)
(pgdb:insert-test-step dbh pgdb-test-id stepname state status event_time comment logfile )
(set! pgdb-step-id (pgdb:get-test-step-id dbh pgdb-test-id stepname state))))
(hash-table-set! step-ht step-id pgdb-step-id ))
(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)))
|
|
|
|
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
|
#f)))
(if step-id
(begin
(if pgdb-test-id
(begin
(if pgdb-step-id
(begin
(print "Updating existing test-step with test-id: " test-id " and step-id " step-id " pgdb test id: " pgdb-test-id )
(pgdb:update-test-step dbh pgdb-step-id pgdb-test-id stepname state status event_time comment logfile))
(begin
(print "Inserting test-step with test-id: " test-id " and step-id " step-id " pgdb test id: " pgdb-test-id)
(pgdb:insert-test-step dbh pgdb-test-id stepname state status event_time comment logfile )
(set! pgdb-step-id (pgdb:get-test-step-id dbh pgdb-test-id stepname state))))
(hash-table-set! step-ht step-id pgdb-step-id ))
(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)))
|
| ︙ | | | ︙ | |
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
|
#f)))
(if data-id
(begin
(if pgdb-test-id
(begin
(if pgdb-data-id
(begin
(print "Updating existing test-data with test-id: " test-id " and data-id " data-id)
(pgdb:update-test-data dbh pgdb-data-id pgdb-test-id category variable value expected tol units comment status type))
(begin
(print "Inserting test-data with test-id: " test-id " and data-id " data-id)
(pgdb:insert-test-data dbh pgdb-test-id category variable value expected tol units comment status type )
(set! pgdb-data-id (pgdb:get-test-data-id dbh pgdb-test-id category variable))))
(hash-table-set! data-ht data-id pgdb-data-id ))
(begin
(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
|
|
|
|
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
|
#f)))
(if data-id
(begin
(if pgdb-test-id
(begin
(if pgdb-data-id
(begin
(print "Updating existing test-data with test-id: " test-id " and data-id " data-id " pgdb test id: " pgdb-test-id)
(pgdb:update-test-data dbh pgdb-data-id pgdb-test-id category variable value expected tol units comment status type))
(begin
(print "Inserting test-data with test-id: " test-id " and data-id " data-id " pgdb test id: " pgdb-test-id)
(pgdb:insert-test-data dbh pgdb-test-id category variable value expected tol units comment status type )
(set! pgdb-data-id (pgdb:get-test-data-id dbh pgdb-test-id category variable))))
(hash-table-set! data-ht data-id pgdb-data-id ))
(begin
(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
|
| ︙ | | | ︙ | |
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
|
;; "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: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))
(begin
(print "Inserting test with run-id: " run-id " and test-id: " test-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)
(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))
(print "WARNING: Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync."))))
test-ids)))
(define (task:add-area-tag dbh area-info tag)
|
|
|
|
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
|
;; "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)
(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))
(begin
(print "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)
(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))
(print "WARNING: Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync."))))
test-ids)))
(define (task:add-area-tag dbh area-info tag)
|
| ︙ | | | ︙ | |