Overview
Comment: | Fixed few bugs in trigger handling |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.64 |
Files: | files | file ages | folders |
SHA1: |
47b1c10120842bd00d51149815c799f6 |
User & Date: | matt on 2017-03-07 09:41:03 |
Other Links: | branch diff | manifest | tags |
Context
2017-03-08
| ||
10:43 | Merged v1.63 into v1.64 check-in: 6d5ee7f187 user: matt tags: v1.64 | |
2017-03-07
| ||
09:41 | Fixed few bugs in trigger handling check-in: 47b1c10120 user: matt tags: v1.64 | |
07:41 | Partially correct sync time handling for cron check-in: 66afe01542 user: matt tags: v1.64 | |
Changes
Modified common.scm from [9f89c1cf57] to [676cf9cc1d].
︙ | ︙ | |||
1913 1914 1915 1916 1917 1918 1919 | (is-in #f)) (for-each (lambda (moment) (if (and before (<= before now-seconds) (>= moment now-seconds)) (begin | | | | | | | | | 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 | (is-in #f)) (for-each (lambda (moment) (if (and before (<= before now-seconds) (>= moment now-seconds)) (begin ;; (print) ;; (print "Before: " (time->string (seconds->local-time before))) ;; (print "Now: " (time->string (seconds->local-time now-seconds))) ;; (print "After: " (time->string (seconds->local-time moment))) ;; (print "Last: " (time->string (seconds->local-time last-done))) (if (< last-done before) (set! is-in before)) )) (set! before moment)) (sort (hash-table-keys all-times) <)) is-in))))) (define (common:extended-cron cron-str now-seconds-in last-done) (let ((expanded-cron (common:cron-expand cron-str))) (if (string? expanded-cron) (common:cron-event expanded-cron now-seconds-in last-done) (let loop ((hed (car expanded-cron)) (tal (cdr expanded-cron))) (if (common:cron-event hed now-seconds-in last-done) #t (if (null? tal) #f (loop (car tal)(cdr tal)))))))) ;;====================================================================== ;; C O L O R S |
︙ | ︙ |
Modified mtut.scm from [fc89c63934] to [ede27f1fb5].
︙ | ︙ | |||
355 356 357 358 359 360 361 362 363 364 365 366 367 368 | (string-split pktsdirs))))) (define (get-pkt-alists pkts) (map (lambda (x) (alist-ref 'pkta x)) ;; 'pkta pulls out the alist from the read pkt pkts)) ;;====================================================================== ;; Runs ;;====================================================================== ;; make a runname ;; (define (make-runname pre post) | > > > > > > > > > > > | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 | (string-split pktsdirs))))) (define (get-pkt-alists pkts) (map (lambda (x) (alist-ref 'pkta x)) ;; 'pkta pulls out the alist from the read pkt pkts)) ;; given list of pkts (alist mode) return list of D cards as Unix epoch, sorted descending ;; also delete duplicates by target i.e. (car pkt) (define (get-pkt-times pkts) (delete-duplicates (sort (map (lambda (x) `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x)))) pkts) (lambda (a b)(> (cdr a)(cdr b)))) ;; sort descending (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target ;;====================================================================== ;; Runs ;;====================================================================== ;; make a runname ;; (define (make-runname pre post) |
︙ | ︙ | |||
462 463 464 465 466 467 468 | (let-values (((uuid pkt) (command-line->pkt (if action action "run") (append `(("-start-dir" . ,area-path) ("-msg" . ,reason) ("-contour" . ,contour)) | | | | | | | 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 | (let-values (((uuid pkt) (command-line->pkt (if action action "run") (append `(("-start-dir" . ,area-path) ("-msg" . ,reason) ("-contour" . ,contour)) (if runname `(("-run-name" . ,runname)) '()) (if new-target `(("-target" . ,new-target)) '()) (if mode-patt `(("-mode-patt" . ,mode-patt)) '()) (if tag-expr `(("-tag-expr" . ,tag-expr)) '()) (if dbdest `(("-sync-to" . ,dbdest)) '()) (if append-conf `(("-append-config" . ,append-conf)) '()) (if (not (or mode-patt tag-expr)) `(("-testpatt" . "%")) '()) ) sched))) (with-output-to-file |
︙ | ︙ | |||
515 516 517 518 519 520 521 | ;; (val-list (string-split-fields ";\\s*" val #:infix)) ;; (string-split val)) ;; runname-rule params (val-alist (val->alist val)) (runname (make-runname "" "")) (runstarts (find-pkts pdb '(runstart) `((o . ,contour) (t . ,runkey)))) (rspkts (get-pkt-alists runstarts)) ;; starttimes is for run start times and is used to know when the last run was launched | | < < < < < < < | < < < < < < < | | > > > < | 526 527 528 529 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 | ;; (val-list (string-split-fields ";\\s*" val #:infix)) ;; (string-split val)) ;; runname-rule params (val-alist (val->alist val)) (runname (make-runname "" "")) (runstarts (find-pkts pdb '(runstart) `((o . ,contour) (t . ,runkey)))) (rspkts (get-pkt-alists runstarts)) ;; starttimes is for run start times and is used to know when the last run was launched (starttimes (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)))) ;; synctimes is for figuring out the last time a sync was done (syncstarts (find-pkts pdb '(syncstart) '())) ;; no qualifiers, a sync does all tarets etc. (sspkts (get-pkt-alists syncstarts)) (synctimes (get-pkt-times sspkts)) (last-sync (if (null? synctimes) ;; if '() then it has never been run, else get the max 0 (apply max (map cdr synctimes)))) ) (let ((delta (lambda (x) (round (/ (- (current-seconds) x) 60))))) (print "runkey: " runkey ", ruletype: " ruletype ", action: " action ", time since; last-run: " (delta last-run) ", last-sync: " (delta last-sync))) ;; look in runstarts for matching runs by target and contour ;; get the timestamp for when that run started and pass it ;; to the rule logic here where "ruletype" will be applied ;; if it comes back "changed" then proceed to register the runs (case (string->symbol (or ruletype "no-such-rule")) |
︙ | ︙ | |||
639 640 641 642 643 644 645 | (if (not url-is-file) ;; need to sync first (fossil:clone-or-sync url fname fdir)) (let-values (((datetime node) (fossil:last-change-node-and-time fdir fname branch))) (if (null? starttimes) (push-run-spec torun contour runkey `((message . ,(conc "fossil:" branch "-neverrun")) | | > | > > > > > | 638 639 640 641 642 643 644 645 646 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 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 | (if (not url-is-file) ;; need to sync first (fossil:clone-or-sync url fname fdir)) (let-values (((datetime node) (fossil:last-change-node-and-time fdir fname branch))) (if (null? starttimes) (push-run-spec torun contour runkey `((message . ,(conc "fossil:" branch "-neverrun")) (runname . ,(conc runname "-" node)) (target . ,runkey))) (if (> datetime last-run) ;; change time is greater than last-run time (push-run-spec torun contour runkey `((message . ,(conc "fossil:" branch "-" node)) (runname . ,(conc runname "-" node)) (target . ,runkey))))) (print "Got datetime=" datetime " node=" node)))) val-alist)) ((file file-or) ;; one or more files must be newer than the reference (let* ((file-globs (alist-ref 'glob val-alist)) (youngestdat (common:get-youngest (common:bash-glob file-globs))) (youngestmod (car youngestdat))) ;; (print "youngestmod: " youngestmod " starttimes: " starttimes) (if (null? starttimes) ;; this target has never been run (push-run-spec torun contour runkey `((message . "file:neverrun") (action . ,action) (target . ,runkey) (runname . ,runname))) ;; (for-each ;; (lambda (starttime) ;; look at the time the last run was kicked off for this contour ;; (if (> youngestmod (cdr starttime)) ;; (begin ;; (print "starttime younger than youngestmod: " starttime " Youngestmod: " youngestmod) (if (> youngestmod last-run) (push-run-spec torun contour runkey `((message . ,(conc ruletype ":" (cadr youngestdat))) (action . ,action) (target . ,runkey) (runname . ,runname) )))))) ;; starttimes)) ((file-and) ;; all files must be newer than the reference (let* ((file-globs (alist-ref 'glob val-alist)) (youngestdat (common:get-youngest file-globs)) (youngestmod (car youngestdat)) (success #t)) ;; any cases of not true, set flag to #f for AND ;; (print "youngestmod: " youngestmod " starttimes: " starttimes) (if (null? starttimes) ;; this target has never been run (push-run-spec torun contour runkey `((message . "file:neverrun") (runname . ,runname) (target . ,runkey) (action . ,action))) ;; NB// I think this is wrong. It should be looking at last-run only. (if (> youngestmod last-run) ;; (for-each ;; (lambda (starttime) ;; look at the time the last run was kicked off for this contour ;; (if (< youngestmod (cdr starttime)) ;; (set! success #f))) ;; starttimes)) ;; (if success ;; (begin ;; (print "starttime younger than youngestmod: " starttime " Youngestmod: " youngestmod) (push-run-spec torun contour runkey `((message . ,(conc ruletype ":" (cadr youngestdat))) (runname . ,runname) (target . ,runkey) (action . ,action) )))))) (else (print "ERROR: unrecognised rule \"" ruletype))))) keydats))) ;; sense rules (hash-table-keys rgconf)) ;; now have to run populated |
︙ | ︙ | |||
728 729 730 731 732 733 734 | (let ((runname (alist-ref 'runname runkeydat)) (reason (alist-ref 'message runkeydat)) (sched (alist-ref 'sched runkeydat)) (action (alist-ref 'action runkeydat)) (dbdest (alist-ref 'dbdest runkeydat)) (append (alist-ref 'append runkeydat)) (target (or (alist-ref 'target runkeydat) runkey))) ;; override with target if forced | | | 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 | (let ((runname (alist-ref 'runname runkeydat)) (reason (alist-ref 'message runkeydat)) (sched (alist-ref 'sched runkeydat)) (action (alist-ref 'action runkeydat)) (dbdest (alist-ref 'dbdest runkeydat)) (append (alist-ref 'append runkeydat)) (target (or (alist-ref 'target runkeydat) runkey))) ;; override with target if forced (print "Have: runkey=" runkey " contour=" contour " area=" area " action=" action " tag-expr=" tag-expr " mode-patt=" mode-patt " target=" target) (if (case (or (and action (string->symbol action)) 'noaction) ;; ensure we have the needed data to run this action ((noaction) #f) ((run) (and runname reason)) ((sync) (and reason dbdest)) (else #f)) ;; instead of unwrapping the runkeydat alist, pass it directly to create-run-pkt (create-run-pkt mtconf action area runkey runname mode-patt tag-expr pktsdir reason contour sched dbdest append) |
︙ | ︙ | |||
804 805 806 807 808 809 810 | (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering (for-each (lambda (pktdat) (let* ((pkta (alist-ref 'pkta pktdat)) (action (alist-ref 'a pkta)) (cmdline (pkt->cmdline pkta)) (uuid (alist-ref 'Z pkta)) | | | > > | 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 | (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering (for-each (lambda (pktdat) (let* ((pkta (alist-ref 'pkta pktdat)) (action (alist-ref 'a pkta)) (cmdline (pkt->cmdline pkta)) (uuid (alist-ref 'Z pkta)) (logf (conc logdir "/" uuid "-run.log")) (fullcmd (conc "NBFAKE_LOG=" logf " nbfake " cmdline))) (print "RUNNING: " fullcmd) (system fullcmd) (mark-processed pdb (list (alist-ref 'id pktdat))) (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 |
︙ | ︙ |
Modified runconfigs.config from [aa6963f9bf] to [90595474a2].
1 2 3 4 | # example of a cron entry to run sync using db spec pgdb, with pgdb setting in file local.config # [a/b/c] | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # example of a cron entry to run sync using db spec pgdb, with pgdb setting in file local.config # [a/b/c] # all:scheduled:sync cron= 0/5 * * * *;dbdest=pgdb;appendconf=/mfs/matt/.sysmaint/local.config # tip will be replaced with hashkey [v1.63/tip/dev] # file: files changes since last run trigger new run # script: script is called with unix seconds as last parameter (other parameters are preserved) # # contour:sensetype:action params data quick:file:run run-name=auto;glob=/home/matt/data/megatest/*.scm # script returns change-time (unix epoch), new-target-name, run-name # # quick:script:run checkfossil = http://www.kiatoa.com/fossils/megatest v1.63;\ # checkfossil = http://www.kiatoa.com/fossils/megatest_qa trunk # fossil based trigger |
︙ | ︙ |
tests/fullrun/tests/runfirst/main.sh became executable with contents [2f5036b48c].
︙ | ︙ |