Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -1915,15 +1915,15 @@ (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))) + ;; (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) <)) @@ -1930,14 +1930,14 @@ 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) - expanded-cron + (common:cron-event expanded-cron now-seconds-in last-done) (let loop ((hed (car expanded-cron)) (tal (cdr expanded-cron))) - (if (cron-event hed now-seconds-in last-done) + (if (common:cron-event hed now-seconds-in last-done) #t (if (null? tal) #f (loop (car tal)(cdr tal)))))))) Index: mtut.scm ================================================================== --- mtut.scm +++ mtut.scm @@ -357,10 +357,21 @@ (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 @@ -464,15 +475,15 @@ (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 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" . "%")) '()) ) @@ -517,39 +528,27 @@ (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 ;; sort by age (youngest first) and delete duplicates by target - (delete-duplicates - (sort - (map (lambda (x) - `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x)))) - rspkts) - (lambda (a b)(> (cdr a)(cdr b)))) ;; sort descending - (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target + (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 - (delete-duplicates - (sort - (map (lambda (x) - `(,(alist-ref 't x) . ,(string->number (alist-ref 'D x)))) - sspkts) - (lambda (a b)(> (cdr a)(cdr b)))) ;; sort descending - (lambda (a b)(equal? (car a)(car b))))) ;; remove duplicates by target + (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)))) - ) - (print "runkey: " runkey " ruletype: " ruletype " action: " action) + (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 @@ -641,15 +640,17 @@ (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)))) + (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)))))) + (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)) @@ -658,10 +659,11 @@ ;; (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 @@ -668,10 +670,11 @@ ;; (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 @@ -682,10 +685,11 @@ ;; (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 @@ -697,10 +701,11 @@ ;; (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)) @@ -730,11 +735,11 @@ (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) + (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)) @@ -806,12 +811,14 @@ (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"))) - (system (conc "NBFAKE_LOG=" logf " nbfake " cmdline)) + (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) Index: runconfigs.config ================================================================== --- runconfigs.config +++ runconfigs.config @@ -1,18 +1,18 @@ # 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= 5 * * * *;dbdest=pgdb;appendconf=/mfs/matt/.sysmaint/local.config +# 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 +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