Overview
Comment: | Updates to area-script trigger to filter packets by area |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65 |
Files: | files | file ages | folders |
SHA1: |
d55ba5cbfdf0cb089cdb58a32d7aaea6 |
User & Date: | jmoon18 on 2018-07-02 11:41:56 |
Other Links: | branch diff | manifest | tags |
Context
2018-07-02
| ||
11:44 | Updated megatest version file check-in: fb7e6638f8 user: jmoon18 tags: v1.65, v1.6512 | |
11:41 | Updates to area-script trigger to filter packets by area check-in: d55ba5cbfd user: jmoon18 tags: v1.65 | |
2018-06-29
| ||
17:47 | Mid-stream update to add area-script capability to triggers check-in: 6f7d6654c5 user: jmoon18 tags: v1.65 | |
Changes
Modified mtut.scm from [7373366efb] to [9ba5c38876].
︙ | ︙ | |||
770 771 772 773 774 775 776 777 778 779 780 781 782 783 | ))) (with-output-to-file (conc pktsdir "/" uuid ".pkt") (lambda () (print pkt)))))) ;; (use trace)(trace create-run-pkt) ;; collect all needed data and create run pkts for contours with changed inputs ;; (define (generate-run-pkts mtconf toppath) (let ((std-runname (conc "sched" (time->string (seconds->local-time (current-seconds)) "%M%H%d")))) (common:with-queue-db mtconf | > | 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 | ))) (with-output-to-file (conc pktsdir "/" uuid ".pkt") (lambda () (print pkt)))))) ;; (use trace)(trace create-run-pkt) (define (contains list x) (cond ((null? list) #f) ((eq? (car list) x) #t) (else (contains (cdr list) x)))) ;; collect all needed data and create run pkts for contours with changed inputs ;; (define (generate-run-pkts mtconf toppath) (let ((std-runname (conc "sched" (time->string (seconds->local-time (current-seconds)) "%M%H%d")))) (common:with-queue-db mtconf |
︙ | ︙ | |||
970 971 972 973 974 975 976 | (last-change (string->number (if (> num-parts 0)(car parts) "abc"))) ;; force no run if not a number returned (new-target (if (> num-parts 1) (cadr parts) runkey)) (new-runname (if (> num-parts 2) (caddr parts) std-runname)) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 | (last-change (string->number (if (> num-parts 0)(car parts) "abc"))) ;; force no run if not a number returned (new-target (if (> num-parts 1) (cadr parts) runkey)) (new-runname (if (> num-parts 2) (caddr parts) std-runname)) (area-pkts (find-pkts pdb '(runstart) `((c . ,contour) (t . ,runkey) (G . ,area )))) (runstarts (filter (lambda (my-pkt) ;;(print my-pkt) (not (contains (map (lambda (c) ;;(print "C: " c "PKT: " my-pkt) (let* ((ctype (car c)) (rx (cdr c)) ;;(foo2 (print "Ctype: " ctype " RX: " rx)) (pkt (alist-ref 'pkt my-pkt)) (apkt (pkt->alist pkt)) (cdat (alist-ref ctype apkt))) (if rx (if (string-match "t" (symbol->string ctype) ) (begin (if #f (print "RX: " rx " CDAT: " (string-join (take (string-split cdat "/") 3) "/"))) (if cdat (string-match rx (string-join (take (string-split cdat "/") 3) "/")) #f)) (begin (if #f (print "RX: " rx " CDAT: " cdat)) (if cdat (string-match rx cdat) #f))) #f) )) `((c . ,contour) (t . ,runkey) (G . ,area))) #f))) area-pkts)) ;;(test (pp runstarts)) (rspkts (common:get-pkt-alists runstarts)) ;; starttimes is for run start times and is used to know when the last run was launched (starttimes (common:get-pkt-times rspkts)) ;; sort by age (youngest first) and delete duplicates by target (last-run (if (null? starttimes) ;; if '() then it has never been run, else get the max 0 (apply max (map cdr starttimes)))) ;; (last-run 9) ;; I think we can do a more valid calculation for this based on the run started packets for this particular area and target (reason "Area-script-triggered") (mode-patt #f) (tag-expr #f) (sched #f) (message (if (null? rem-lines) cmd (string-intersperse rem-lines "-"))) |
︙ | ︙ | |||
1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 | (let-values (((ack-uuid ack-pkt) (add-z-card (construct-sdat 'P uuid 'T (case (string->symbol action) ((run) "runstart") ((sync) "syncstart") ;; example of translating run -> runstart (else action)) 'c (alist-ref 'c pkta) ;; THIS IS WRONG! SHOULD BE 'c 't (alist-ref 't pkta))))) (write-pkt pktsdir ack-uuid ack-pkt)))) (begin ;; access denied! Mark as such (mark-processed pdb (list (alist-ref 'id pktdat))) (let-values (((ack-uuid ack-pkt) (add-z-card | > | 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 | (let-values (((ack-uuid ack-pkt) (add-z-card (construct-sdat 'P uuid 'T (case (string->symbol action) ((run) "runstart") ((sync) "syncstart") ;; example of translating run -> runstart (else action)) 'G (alist-ref 'G pkta) 'c (alist-ref 'c pkta) ;; THIS IS WRONG! SHOULD BE 'c 't (alist-ref 't pkta))))) (write-pkt pktsdir ack-uuid ack-pkt)))) (begin ;; access denied! Mark as such (mark-processed pdb (list (alist-ref 'id pktdat))) (let-values (((ack-uuid ack-pkt) (add-z-card |
︙ | ︙ |