125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
;;======================================================================
;; T R I G G E R S
;;======================================================================
(define (mt:process-triggers run-id test-id newstate newstatus)
(let* ((test-dat (rmt:get-test-info-by-id run-id test-id))
(test-rundir ;; (filedb:get-path *fdb*
(db:test-get-rundir test-dat)) ;; )
(test-name (db:test-get-testname test-dat))
(tconfig #f)
(state (if newstate newstate (db:test-get-state test-dat)))
(status (if newstatus newstatus (db:test-get-status test-dat))))
(if (and (file-exists? test-rundir)
(directory? test-rundir))
(begin
(push-directory test-rundir)
(set! tconfig (mt:lazy-read-test-config test-name))
(pop-directory)
(for-each (lambda (trigger)
(let ((cmd (configf:lookup tconfig "triggers" trigger))
|
|
|
>
|
|
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
;;======================================================================
;; T R I G G E R S
;;======================================================================
(define (mt:process-triggers run-id test-id newstate newstatus)
(let* ((test-dat (rmt:get-test-info-by-id run-id test-id))
(test-rundir (rmt:sdb-qry 'getstr ;; (filedb:get-path *fdb*
(db:test-get-rundir test-dat))) ;; )
(test-name (db:test-get-testname test-dat))
(tconfig #f)
(state (if newstate newstate (db:test-get-state test-dat)))
(status (if newstatus newstatus (db:test-get-status test-dat))))
(if (and test-rundir ;; #f means no dir set yet
(file-exists? test-rundir)
(directory? test-rundir))
(begin
(push-directory test-rundir)
(set! tconfig (mt:lazy-read-test-config test-name))
(pop-directory)
(for-each (lambda (trigger)
(let ((cmd (configf:lookup tconfig "triggers" trigger))
|