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
|
(spec-id (pgdb:get-ttype dbh keytarg))
(new-run-id (pgdb:get-run-id dbh spec-id target run-name))
;; (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)
new-run-id)
(if (handle-exceptions
exn
(begin (print-call-chain) #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)
#f))))))
(define (tasks:sync-tests-data dbh cached-info test-ids)
(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))
|
>
>
|
>
>
>
|
|
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
681
|
(spec-id (pgdb:get-ttype dbh keytarg))
(new-run-id (pgdb:get-run-id dbh spec-id target run-name))
;; (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)
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)
#f))))))
(define (tasks:sync-tests-data dbh cached-info test-ids)
(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))
|
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
|
(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-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path)))
(if pgdb-test-id ;; have a record
(begin ;; let ((key-name (conc run-id "/" test-name "/" item-path)))
(hash-table-set! test-ht test-id pgdb-test-id)
(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))
(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))
))
test-ids)))
;; get runs changed since last sync
;; (define (tasks:sync-test-data dbh cached-info area-info)
;; (let* ((
|
>
>
>
>
|
>
>
>
|
|
>
|
692
693
694
695
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
|
(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-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"
;; "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)))
(hash-table-set! test-ht test-id pgdb-test-id)
(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))
(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)))
(print "Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync."))
))
test-ids)))
;; get runs changed since last sync
;; (define (tasks:sync-test-data dbh cached-info area-info)
;; (let* ((
|