14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
+
+
+
+
+
+
|
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
(declare (unit diff-report))
(declare (uses common))
(declare (uses debugprint))
(declare (uses rmt))
(declare (uses rmtmod))
(declare (uses commonmod))
(import commonmod
rmtmod
debugprint)
(include "common_records.scm")
(use matchable)
(use fmt)
(use ducttape-lib)
(define css "")
|
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
-
+
|
#f))))
(define (diff:target+run-name->run-id target run-name)
(let* ((keys (rmt:get-keys))
(target-parts (if target (string-split target "/") (map (lambda (x) "%") keys))))
(if (not (eq? (length keys) (length keys)))
(begin
(print "Error: Target ("target") item count does not match fields count target tokens="target-parts" fields="keys)
(debug:print 0 *default-log-port* "Error: Target ("target") item count does not match fields count target tokens="target-parts" fields="keys)
#f)
(let* ((target-map (zip keys target-parts))
(qry-res (rmt:get-runs run-name 1 0 target-map)))
(if (eq? 2 (vector-length qry-res))
(let ((first-ent (vector-ref qry-res 1)))
(if (> (length first-ent) 0)
|
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
|
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
+
|
)
(if html-output-file
(with-output-to-file html-output-file (lambda () (print html-body))))
(when (and email-recipients-list (> (length email-recipients-list) 0))
(sendmail (string-join email-recipients-list ",") email-subject html-body use_html: #t))
html-body))
;; (let* ((src-run-name "all57")
;; (dest-run-name "all60")
;; (src-run-id (diff:run-name->run-id src-run-name))
;; (dest-run-id (diff:run-name->run-id dest-run-name))
;; (to-list (list "bjbarcla")))
;; (diff:deliver-diff-report src-run-id dest-run-id email-recipients-list: to-list html-output-file: "/tmp/bjbarcla/zippy.html")
;; )
(print "No match for source target/runname="src-target"/"src-runname)
(print "Cannot proceed.")
(debug:print 0 *default-log-port* "No match for source target/runname="src-target"/"src-runname)
(debug:print 0 *default-log-port* "Cannot proceed.")
#f)
((not dest-run-id)
(print "No match for source target/runname="dest-target"/"dest-runname)
(print "Cannot proceed.")
(debug:print 0 *default-log-port* "No match for source target/runname="dest-target"/"dest-runname)
(debug:print 0 *default-log-port* "Cannot proceed.")
#f)
(else
(diff:deliver-diff-report src-run-id dest-run-id email-recipients-list: to-list html-output-file: html-file)))))
|