Megatest

Diff
Login

Differences From Artifact [836619b7ba]:

To Artifact [ea91541450]:


344
345
346
347
348
349
350

351
352
353













354
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





380
381
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
344
345
346
347
348
349
350
351



352
353
354
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
380
381
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







+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+



















-
+


-
-
-
-
+
+
+
+
+







-
+
+

-
-
+
+













-
+







	  (let* ((keydats   (configf:get-section rgconf runkey)))
	    (for-each
	     (lambda (sense) ;; these are the sense rules
	       (let* ((key        (car sense))
		      (val        (cadr sense))
		      (keyparts   (string-split key ":"))
		      (contour    (car keyparts))
		      (len-key    (length keyparts))
		      (ruletype   (let ((res (cdr keyparts)))
				    (if (null? res) #f (cadr keyparts))))
		      (valparts   (string-split val)) ;; runname-rule params
		      (ruletype   (if (> len-key 1)(cadr keyparts) #f))
		      (action     (if (> len-key 2)(caddr keyparts) #f))
		      (val-list   (string-split-fields ";\\s*" val #:infix)) ;; (string-split val)) ;; runname-rule params
		      (val-alist  (if val-list
				      (map (lambda (x)
					     (let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
					       (case (length f)
						 ((0) `(,#f))  ;; null string case
						 ((1) `(,(string->symbol (car f))))
						 ((2) `(,(string->symbol (car f)) . ,(cadr f)))
						 (else f))))
					   val-list)
				      '()))
		      (runname    (make-runname "" ""))
		      (runstarts  (find-pkts pdb '(runstart) `((o . ,contour)
							       (t . ,runkey))))
		      (rspkts     (map (lambda (x)
					 (alist-ref 'pkta x))
				       runstarts))
		      (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
		      )
		 ;; 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 ruletype)
		   ((scheduled)
		    (if (not (eq? (length valparts) 6))
			(print "ERROR: bad sense spec \"" (string-intersperse sense " ") "\"")
			(let* ((run-name (car valparts))
			       (crontab  (string-intersperse (cdr valparts)))
		    (if (not (alist-ref 'cron val-alist)) ;; gotta have cron spec
			(print "ERROR: bad sense spec \"" (string-intersperse sense " ") "\" params: " val-alist)
			(let* ((run-name (alist-ref 'run-name val-alist))
			       (crontab  (alist-ref 'cron     val-alist))
			       (action   (alist-ref 'action   val-alist))
			       (last-run (if (null? starttimes) ;; never run
					     0
					     (apply max (map cdr starttimes))))
			       (need-run (common:cron-event crontab #f last-run))
			       (runname  (if need-run (conc "sched" (time->string (seconds->local-time (current-seconds)) "%M%H%d")))))
			  (print "last-run: " last-run " need-run: " need-run)
			  (if need-run
			      (configf:section-var-set! torun contour runkey `(,(conc ruletype ":" (string-intersperse (cdr valparts) "-")) ,runname ,need-run))))))
			      (configf:section-var-set! torun contour runkey `(,(conc ruletype ":" (string-intersperse (string-split (alist-ref 'cron val-alist)) "-"))
									       ,runname ,need-run ,action))))))
		   ((file file-or) ;; one or more files must be newer than the reference
		    (let* ((file-globs  (cdr valparts))
			   (youngestdat (common:get-youngest file-globs))
		    (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
			  (configf:section-var-set! torun contour runkey `("file:neverrun" ,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)
				   (configf:section-var-set! torun contour runkey `(,(conc ruletype ":" (cadr youngestdat)) ,runname #f)))))
			   starttimes))
		      ))
		   ((file-and) ;; all files must be newer than the reference
		    (let* ((file-globs  (cdr valparts))
		    (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
			  (configf:section-var-set! torun contour runkey `("file:neverrun" ,runname #f))
			  (for-each