20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
(use format typed-records) ;; RADT => purpose of json format??
(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")
(include "db_records.scm")
;; (declare (uses rmtmod))
;; (import rmtmod)
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
|
|
|
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
(use format typed-records) ;; RADT => purpose of json format??
(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")
;; (include "db_records.scm")
;; (declare (uses rmtmod))
;; (import rmtmod)
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
|
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
|
(rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))
;; run-id is NOT used - but it will be!
;;
(define (rmt:get-test-info-by-id run-id test-id)
(if (number? test-id)
(let* ((testdat (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id)))
(trundatf (conc (db:test-get-rundir testdat) "/.mt_data/test-run.dat")))
;; now we can update a couple fields from the filesystem
(if (and (db:test-get-rundir testdat)
(file-exists? trundatf))
(let* ((duration (db:test-get-run_duration testdat))
(event-time (db:test-get-event_time testdat))
(last-touch (file-modification-time trundatf)))
(db:test-set-run_duration! testdat (max duration (- last-touch event-time)))))
testdat)
(begin
(debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
(print-call-chain (current-error-port))
#f)))
(define (rmt:test-get-rundir-from-test-id run-id test-id)
|
>
|
>
>
>
>
>
|
|
|
|
|
>
>
|
|
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
|
(rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))
;; run-id is NOT used - but it will be!
;;
(define (rmt:get-test-info-by-id run-id test-id)
(if (number? test-id)
(let* ((testdat (rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id)))
(trundir (vector-ref testdat 10))
(trundatf (conc trundir"/.mt_data/test-run.dat")))
;; now we can update a couple fields from the filesystem
(handle-exceptions
exn
(begin
(debug:print-info 0 *default-log-port* "Could not update testdat record from "trundatf", exn=" exn)
#f)
(if (and trundir
(file-exists? trundatf))
(let* ((duration (vector-ref testdat 12)) ;; (db:test-get-run_duration testdat))
(event-time (vector-ref testdat 5)) ;; (db:test-get-event_time testdat))
(last-touch (file-modification-time trundatf))
(new-duration (max duration (- last-touch event-time))))
(vector-set! testdat 12 new-duration))))
#;(db:test-set-run_duration! testdat (max duration (- last-touch event-time)))
testdat)
(begin
(debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
(print-call-chain (current-error-port))
#f)))
(define (rmt:test-get-rundir-from-test-id run-id test-id)
|