Index: mtut.scm
==================================================================
--- mtut.scm
+++ mtut.scm
@@ -19,10 +19,11 @@
 ;; (include "common.scm")
 ;; (include "megatest-version.scm")
 
 ;; fake out readline usage of toplevel-command
 (define (toplevel-command . a) #f)
+(define *default-log-port* (current-error-port))
 
 (use srfi-1 posix srfi-69 readline ;;  regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
      srfi-18 extras format pkts regex regex-case
      (prefix dbi dbi:)
      nanomsg)
@@ -459,11 +460,11 @@
 	       (args:get-arg "-envcap")
 	       (args:get-arg "-envdelta")
 	       (member *action* '("db" "tsend" "tlisten"))   ;; very loose checks on db and tsend/listen
 	       (equal? *action* "show")    ;; just keep going if list
 	       )))
-    (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))
+    (print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))
 
 (if (or (args:any? "-h" "help" "-help" "--help")
 	(member *action* '("-h" "-help" "--help" "help")))
     (begin
       (print help)
@@ -580,11 +581,11 @@
 			       (list 'S area-path) ;; the area-path is mapped to the start-dir
 			       '())
                            (if (list? extra-dat)
 			       extra-dat
 			       (begin
-				 (debug-print 0 log-port "ERROR: command-line->pkt received bad extra-dat " extra-dat)
+				 (common:debug-print 0 log-port "ERROR: command-line->pkt received bad extra-dat " extra-dat)
 				 '()))
 			   (map (lambda (x)
 				  (let* ((param (car x))
 					 (value (cdr x))
 					 (pmeta (assoc param *arg-keys*))    ;; translate the card key to a megatest switch or parameter
@@ -741,15 +742,16 @@
 
 ;; 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")))
-	(pktsdir-str   (configf:lookup mtconf "scratchdat" "toppath"))
+	(pktsdir       (get-pkts-dir mtconf toppath))
 	(setup-pdbpath (configf:lookup mtconf "setup"  "pdbpath")))
     (common:with-queue-db
-     pktsdir-str
+     pktsdir
      setup-pdbpath
+     toppath
      (lambda (pktsdirs pktsdir pdb)
        (let* ((rgconfdat (configf:find-and-read-config (conc toppath "/runconfigs.config")))
 	      (rgconf    (car rgconfdat))
 	      (all-areas (map car (configf:get-section mtconf "areas")))
 	      (contours  (configf:get-section mtconf "contours"))
@@ -1102,10 +1104,16 @@
 	  (conc pktsdir "/" uuid ".pkt")
 	(lambda ()
 	  (print pkt)))
       (print "ERROR: cannot process commands without a pkts directory")))
 
+(define (get-pkts-dir mtconf toppath-in)
+  (let* ((toppath   (or toppath-in (configf:lookup mtconf "scratchdat" "toppath")))
+	 (pktsdirs  (or (configf:lookup mtconf "setup" "pktsdirs")
+			toppath)))
+    (common:get-pkts-dirs #t toppath: toppath pktsdirs: pktsdirs)))
+
 ;; collect all needed data and create run pkts for contours with changed inputs
 ;;
 (define (dispatch-commands mtconf toppath)
   ;; we are expecting a directory "logs", check and create it, create the log in /tmp if not able to create logs dir
   (let* ((logdir
@@ -1120,15 +1128,16 @@
 	     "/tmp"))
 	(cpuload (alist-ref 'adj-proc-load (common:get-normalized-cpu-load logdir #f)))
 	(maxload (string->number (or (configf:lookup mtconf "setup" "maxload")
 				     (configf:lookup mtconf "jobtools" "maxload") ;; respect value used by Megatest calls
 				     "1.1")))
-	(pktsdir-str   (configf:lookup mtconf "scratchdat" "toppath"))
+	(pktsdir       (get-pkts-dir mtconf toppath)) ;; (configf:lookup mtconf "scratchdat" "toppath"))
 	(setup-pdbpath (configf:lookup mtconf "setup"  "pdbpath")))
     (common:with-queue-db
-     pktsdir-str
+     pktsdir
      setup-pdbpath
+     toppath
      (lambda (pktsdirs pktsdir pdb)
        (let* ((rgconfdat (configf:find-and-read-config (conc toppath "/runconfigs.config")))
 	      (rgconf    (car rgconfdat))
 	      (areas     (configf:get-section mtconf "areas"))
 	      (contours  (configf:get-section mtconf "contours"))
@@ -1183,34 +1192,29 @@
 			   (string-split (or (configf:lookup mtconf "access" area) ;; userid:rightstype userid2:rightstype2 ...
 					     (if access-ctrl
 						 "*:none"  ;; nobody has access by default
 						 "*:all")))))
 	 (access-types-dat (configf:get-section mtconf "accesstypes")))
-    (debug:print 2 *default-log-port* "Checking access in " access-list " with access-ctrl " access-ctrl " for area " area)
+    (common:debug-print 2 *default-log-port* "Checking access in " access-list " with access-ctrl " access-ctrl " for area " area)
     (if access-ctrl
 	(let* ((user-access     (or (assoc user access-list)
 				    (assoc "*"  access-list)))
 	       (access-type   (if user-access
 												  (cadr user-access)
                            #f))
 	       (access-types    (let ((res (alist-ref access-type access-types-dat equal?)))
 				  (if res (car res) res)))
 	       (allowed-actions (string-split (or access-types ""))))
-	  (debug:print 2 *default-log-port* "Got " allowed-actions " for user " user " where access-types=" access-types " access-type=" access-type)
+	  (common:debug-print 2 *default-log-port* "Got " allowed-actions " for user " user " where access-types=" access-types " access-type=" access-type)
 	  (cond
 	   ((and access-types (member action allowed-actions))
 	    ;; (print "Access granted for " user " for " action)
 	    #t)
 	   (else
 	    ;; (print "Access denied for " user " for " action)
 	    #f))))))
 
-(define (get-pkts-dir mtconf)
-  (let ((pktsdirs  (configf:lookup mtconf "setup" "pktsdirs"))
-	(pktsdir   (if pktsdirs (car (string-split pktsdirs " ")) #f)))
-    pktsdir))
-
 (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc")))
   (if (file-exists? debugcontrolf)
       (load debugcontrolf)))
 
 (if *action*
@@ -1220,12 +1224,11 @@
 	      (mtconf    (car mtconfdat))
 	      (area      (args:get-arg "-area")) ;; look up the area to dispatch to from [areas] section
 	      (areasec   (if area (configf:lookup mtconf "areas" area) #f))
 	      (areadat   (if areasec (configf:val->alist areasec) #f))
 	      (area-path (if areadat (alist-ref 'path areadat) #f))
-	      (pktsdirs  (configf:lookup mtconf "setup" "pktsdirs"))
-	      (pktsdir   (if pktsdirs (car (string-split pktsdirs " ")) #f))
+	      (pktsdir   (get-pkts-dir mtconf #f))
 	      (adjargs   (hash-table-copy args:arg-hash))
 	      (new-ss    (args:get-arg "-new")))
 	 ;; check a few things
 	 (cond
 	  ((and area (not area-path))
@@ -1237,17 +1240,17 @@
 	  (else
 	   (let* ((usr-admin (check-access (current-user-name) mtconf "override" area))
 					(user (if (and usr-admin (args:get-arg "-override-user"))
                     (args:get-arg "-override-user")
 									  (current-user-name))))
-       ; (print "user 123 " usr-admin )
-        ;(exit 1)
-     (if (and (not usr-admin) (args:get-arg "-override-user"))
-         (begin
-            (print  user " does not have access to override user")
-          (exit 1)))
-	   (if (check-access user mtconf *action* area);; check rights
+					; (print "user 123 " usr-admin )
+					;(exit 1)
+	     (if (and (not usr-admin) (args:get-arg "-override-user"))
+		 (begin
+		   (print  user " does not have access to override user")
+		   (exit 1)))
+	     (if (check-access user mtconf *action* area);; check rights
 		 (print "Access granted for " *action* " action by " user)
 		 (begin
 		   (print "Access denied for " *action* " action by " user)
 		   (exit 1))))))
 	 
@@ -1261,19 +1264,19 @@
 	   (write-pkt pktsdir uuid pkt))))
       ((dispatch import rungen process)
        (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
 	      (mtconf    (car mtconfdat))
 	      (toppath   (configf:lookup mtconf "scratchdat" "toppath"))
-	      (pktsdir-str   (or (configf:lookup mtconf "scratchdat" "toppath")(configf:lookup mtconf "setup" "pktsdir")))
+	      (pktsdir   (get-pkts-dir mtconf #f))
 	      (setup-pdbpath (configf:lookup mtconf "setup"  "pdbpath")))
 	 (case (string->symbol *action*)
 	   ((process)  (begin
-			 (common:load-pkts-to-db pktsdir-str setup-pdbpath)
+			 (common:load-pkts-to-db pktsdir setup-pdbpath toppath)
 			 (generate-run-pkts mtconf toppath)
-			 (common:load-pkts-to-db pktsdir-str setup-pdbpath)
+			 (common:load-pkts-to-db pktsdir setup-pdbpath toppath)
 			 (dispatch-commands mtconf toppath)))
-	   ((import)   (common:load-pkts-to-db pktsdir-str setup-pdbpath)) ;; import pkts
+	   ((import)   (common:load-pkts-to-db pktsdir setup-pdbpath toppath)) ;; import pkts
 	   ((rungen)   (generate-run-pkts mtconf toppath))
 	   ((dispatch) (dispatch-commands mtconf toppath)))))
       ;; misc
       ((show)
        (if (> (length remargs) 0)
@@ -1290,16 +1293,18 @@
 		 (print "No section \"" (car remargs) "\" found")))
 	   (print "ERROR: list requires section parameter; areas, setup or contours")))
       ((gendot)
        (let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
 	      (mtconf    (car mtconfdat))
-	      (pktsdir-str   (configf:lookup mtconf "scratchdat" "toppath"))
-	      (setup-pdbpath (configf:lookup mtconf "setup"  "pdbpath")))
-	 (common:load-pkts-to-db pktsdir-str setup-pdbpath use-lt: #t) ;; need to NOT do this by default ...
+	      (pktsdir   (get-pkts-dir mtconf #f))
+	      (setup-pdbpath (configf:lookup mtconf "setup"  "pdbpath"))
+	      (toppath   (configf:lookup mtconfig "scratchdat" "toppath")))
+	 (common:load-pkts-to-db pktsdir setup-pdbpath toppath use-lt: #t) ;; need to NOT do this by default ...
 	 (common:with-queue-db
-	  pktsdir-str
+	  pktsdir
 	  setup-pdbpath
+	  toppath
 	  (lambda (pktsdirs pktsdir conn)
 	    ;;                       pktspec display-fields 
 	    (make-report "out.dot" conn
 			 '((cmd      . ((parent . P)
 					(user   . M)

Index: src/mtcommon.scm
==================================================================
--- src/mtcommon.scm
+++ src/mtcommon.scm
@@ -35,18 +35,44 @@
          calc-verbosity
 	 ;; pkts stuff
 	 load-pkts-to-db	 
 	 get-pkt-alists
 	 with-queue-db
+	 get-pkts-dirs
+	 get-pkt-times
 	 ;; unix stuff
 	 get-cached-info
 	 write-cached-info
 	 get-normalized-cpu-load
+	 bash-glob
+	 get-youngest
+	 ;; time
+	 hms-string->seconds
+	 seconds->hr-min-sec
+	 seconds->time-string
+	 seconds->work-week/day-time
+	 seconds->work-week/day
+	 seconds->year-work-week/day
+	 seconds->year-work-week/day-time
+	 seconds->year-week/day-time
+	 seconds->quarter
+	 date-time->seconds
+	 find-start-mark-and-mark-delta
+	 expand-cron-slash
+	 cron-expand
+	 cron-event
+	 extended-cron
+	 ;; other
+	 get-param-mapping
+	 ;; debug
+	 debug-print
+	 print-error
+	 print-info
          )
 
 (import scheme chicken data-structures extras posix ports)
-(use (prefix sql-de-lite sql:) posix typed-records format srfi-1 srfi-69 pkts regex (prefix dbi dbi:) regex-case)
+(use (prefix sql-de-lite sql:) posix typed-records format srfi-1 srfi-69 pkts regex (prefix dbi dbi:) regex-case matchable)
 
 (defstruct ctrldat
   (port      (current-error-port))
   (verbosity 1)
   (vcache    (make-hash-table))
@@ -321,10 +347,40 @@
 		   (core-rx  ( x c         ) (loop (car tal)(cdr tal) loads           proc-num phys-num (max-num c core-num)))
 		   (else 
 		    (begin
 		      ;; (print "NO MATCH: " hed)
 		      (loop (car tal)(cdr tal) loads proc-num phys-num core-num)))))))))))
+
+;; use bash to expand a glob. Does NOT handle paths with spaces!
+;;
+(define (bash-glob instr)
+  (string-split
+   (with-input-from-pipe
+       (conc "/bin/bash -c \"echo " instr "\"")
+     read-line)))
+
+;; return the youngest timestamp . filename
+;;
+(define (get-youngest glob-list)
+  (let ((all-files (apply append
+			  (map (lambda (patt)
+				 (handle-exceptions
+				     exn
+				     '()
+				   (glob patt)))
+			       glob-list))))
+    (fold (lambda (fname res)
+	    (let ((last-mod (car res))
+		  (curmod   (handle-exceptions
+				exn
+				0
+			      (file-modification-time fname))))
+	      (if (> curmod last-mod)
+		  (list curmod fname)
+		  res)))
+	  '(0 "n/a")
+	  all-files)))
 
 ;;======================================================================
 ;; L O G G I N G    D B 
 ;;======================================================================
 
@@ -393,14 +449,19 @@
 
 ;;======================================================================
 ;; pkts stuff
 ;;======================================================================
 
-(define (load-pkts-to-db pktsdir-str setup-pdbpath #!key (use-lt #f)(log-port (current-error-port)))
-  (with-queue-db
-     pktsdir-str
+;; load-pkts-to-db *used* to take a list of pkts dirs and roll them into a single db. This is now broken.
+;;
+(define (load-pkts-to-db pktsdir setup-pdbpath toppath #!key (use-lt #f)(log-port (current-error-port)))
+  (let ((pktsdirs (if (list? pktsdir) pktsdir `(,pktsdir)))
+	(pktsdir  (if (list? pktsdir) (car pktsdir) pktsdir)))
+    (with-queue-db
+     pktsdir
      setup-pdbpath
+     toppath
      (lambda (pktsdirs pktsdir pdb)
        (for-each
 	(lambda (pktsdir) ;; look at all
 	  (cond
 	   ((not (file-exists? pktsdir))
@@ -426,36 +487,41 @@
 			 (debug-print 4 log-port "Added " uuid " of type " ptype " to queue"))
 		       (debug-print 4 log-port "pkt: " uuid " exists, skipping...")
 		       )))
 	       pkts)))))
 	pktsdirs))
-     use-lt: use-lt))
-  
+     use-lt: use-lt)))
+
 (define (get-pkt-alists pkts)
   (map (lambda (x)
 	 (alist-ref 'apkt x)) ;; 'pkta pulls out the alist from the read pkt
        pkts))
 
-(define (with-queue-db pktsdir-str setup-pdbpath proc #!key (use-lt #f)(toppath-in #f)(log-port (current-error-port)))
-  (let* ((pktsdirs (get-pkts-dirs use-lt pktsdir-str))
-	 (pktsdir  (if pktsdirs (car pktsdirs) #f))
-	 (toppath  toppath-in) ;; (or (configf:lookup mtconf "scratchdat" "toppath") toppath-in))
+(define (with-queue-db pktsdir setup-pdbpath toppath proc #!key (use-lt #f)(log-port (current-error-port)))
+  (let* ((pktsdirs (if (list? pktsdir) pktsdir `(,pktsdir))) ;; FIXME, ignoring all possible pkts dirs for now. (get-pkts-dirs use-lt pktsdir-str))
+	 (pktsdir  (if (list? pktsdir)(car pktsdir) pktsdir))
+	 ;; (toppath  toppath-in) ;; (or (configf:lookup mtconf "scratchdat" "toppath") toppath-in))
 	 (pdbpath  (or setup-pdbpath pktsdir))) ;; (configf:lookup mtconf "setup"  "pdbpath")
     (cond
-     ((not (and  pktsdir toppath pdbpath))
-      (debug-print 0 log-port "ERROR: settings are missing in your megatest.config for area management.")
-      (debug-print 0 log-port "  you need to have pktsdir in the [setup] section."))
-     ((not (file-exists? pktsdir))
+     ((not pktsdir)
+      (debug-print 0 log-port "ERROR: pktsdir missing from setup section in your megatest.config for area management."))
+     ((not toppath)
+      (debug-print 0 log-port "ERROR: toppath not found, area management config problem?"))
+     ((not pdbpath)
+      (debug-print 0 log-port "ERROR: pdbpath not found. Should be derived from pktsdir?"))
+     ((not (directory-exists? pktsdir))
       (debug-print 0 log-port "ERROR: pkts directory not found " pktsdir))
      ((not (equal? (file-owner pktsdir)(current-effective-user-id)))
       (debug-print 0 log-port "ERROR: directory " pktsdir " is not owned by " (current-effective-user-name)))
      (else
 	(let* ((pdb  (open-queue-db pdbpath "pkts.db"
 				    schema: '("CREATE TABLE groups (id INTEGER PRIMARY KEY,groupname TEXT, CONSTRAINT group_constraint UNIQUE (groupname));"))))
 	  (proc pktsdirs pktsdir pdb)
 	  (dbi:close pdb))))))
 
+;; look at consolidating this with mtut.scm get-pkts-dir
+;;
 ;; (configf:lookup mtconf "setup"  "pktsdirs")
 (define (get-pkts-dirs use-lt #!key (top-path #f)(pktsdirs #f))
   (let* ((pktsdirs-str (or pktsdirs
 			   (and use-lt
 				(conc (or top-path
@@ -463,7 +529,315 @@
 				      "/lt/.pkts"))))
 	 (pktsdirs  (if pktsdirs-str
 			(string-split pktsdirs-str " ")
 			#f)))
     pktsdirs))
+
+;; 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
+
+;;======================================================================
+;; T I M E   A N D   D A T E
+;;======================================================================
+
+;; Convert strings like "5s 2h 3m" => 60x60x2 + 3x60 + 5
+(define (hms-string->seconds tstr)
+  (let ((parts     (string-split-fields "\\w+" tstr))
+	(time-secs 0)
+	;; s=seconds, m=minutes, h=hours, d=days, M=months, y=years, w=weeks
+	(trx       (regexp "(\\d+)([smhdMyw])")))
+    (for-each (lambda (part)
+		(let ((match  (string-match trx part)))
+		  (if match
+		      (let ((val (string->number (cadr match)))
+			    (unt (caddr match)))
+			(if val 
+			    (set! time-secs (+ time-secs (* val
+							    (case (string->symbol unt)
+							      ((s) 1)
+							      ((m) 60) ;; minutes
+							      ((h) 3600)
+							      ((d) 86400)
+							      ((w) 604800)
+							      ((M) 2628000) ;; aproximately one month
+							      ((y) 31536000)
+							      (else #f))))))))))
+	      parts)
+    time-secs))
+		       
+(define (seconds->hr-min-sec secs)
+  (let* ((hrs (quotient secs 3600))
+	 (min (quotient (- secs (* hrs 3600)) 60))
+	 (sec (- secs (* hrs 3600)(* min 60))))
+    (conc (if (> hrs 0)(conc hrs "hr ") "")
+	  (if (> min 0)(conc min "m ")  "")
+	  sec "s")))
+
+(define (seconds->time-string sec)
+  (time->string 
+   (seconds->local-time sec) "%H:%M:%S"))
+
+(define (seconds->work-week/day-time sec)
+  (time->string
+   (seconds->local-time sec) "ww%V.%u %H:%M"))
+
+(define (seconds->work-week/day sec)
+  (time->string
+   (seconds->local-time sec) "ww%V.%u"))
+
+(define (seconds->year-work-week/day sec)
+  (time->string
+   (seconds->local-time sec) "%yww%V.%w"))
+
+(define (seconds->year-work-week/day-time sec)
+  (time->string
+   (seconds->local-time sec) "%Yww%V.%w %H:%M"))
+
+(define (seconds->year-week/day-time sec)
+  (time->string
+   (seconds->local-time sec) "%Yw%V.%w %H:%M"))
+
+(define (seconds->quarter sec)
+  (case (string->number
+	 (time->string 
+	  (seconds->local-time sec)
+	  "%m"))
+    ((1 2 3) 1)
+    ((4 5 6) 2)
+    ((7 8 9) 3)
+    ((10 11 12) 4)
+    (else #f)))
+
+;; basic ISO8601 format (e.g. "2017-02-28 06:02:54") date time => Unix epoch
+;;
+(define (date-time->seconds datetime)
+  (local-time->seconds (string->time datetime "%Y-%m-%d %H:%M:%S")))
+
+;; given span of seconds tstart to tend
+;; find start time to mark and mark delta
+;;
+(define (find-start-mark-and-mark-delta tstart tend)
+  (let* ((deltat   (- (max tend (+ tend 10)) tstart)) ;; can't handle runs of less than 4 seconds. Pad it to 10 seconds ...
+	 (result   #f)
+	 (min      60)
+	 (hr       (* 60 60))
+	 (day      (* 24 hr))
+	 (yr       (* 365 day)) ;; year
+	 (mo       (/ yr 12))
+	 (wk       (* day 7)))
+    (for-each
+     (lambda (max-blks)
+       (for-each
+	(lambda (span) ;; 5 2 1
+	  (if (not result)
+	      (for-each 
+	       (lambda (timeunit timesym) ;; year month day hr min sec
+		 (if (not result)
+		     (let* ((time-blk (* span timeunit))
+			    (num-blks (quotient deltat time-blk)))
+		       (if (and (> num-blks 4)(< num-blks max-blks))
+			   (let ((first (* (quotient tstart time-blk) time-blk)))
+			     (set! result (list span timeunit time-blk first timesym))
+			     )))))
+	       (list yr mo wk day hr min 1)
+	       '(     y  mo w  d   h  m   s))))
+	(list 8 6 5 2 1)))
+     '(5 10 15 20 30 40 50 500))
+    (if values
+	(apply values result)
+	(values 0 day 1 0 'd))))
+
+;; given x y lim return the cron expansion
+;;
+(define (expand-cron-slash x y lim)
+  (let loop ((curr x)
+	     (res  `()))
+    (if (< curr lim)
+	(loop (+ curr y) (cons curr res))
+	(reverse res))))
+
+;; expand a complex cron string to a list of cron strings
+;;
+;;  x/y   => x, x+y, x+2y, x+3y while x+Ny<max_for_field
+;;  a,b,c => a, b ,c
+;;
+;;   NOTE: with flatten a lot of the crud below can be factored down.
+;;
+(define (cron-expand cron-str)
+  (if (list? cron-str)
+      (flatten
+       (fold (lambda (x res)
+	       (if (list? x)
+		   (let ((newres (map cron-expand x)))
+		     (append x newres))
+		   (cons x res)))
+	     '()
+	     cron-str)) ;; (map common:cron-expand cron-str))
+      (let ((cron-items (string-split cron-str))
+	    (slash-rx   (regexp "(\\d+)/(\\d+)"))
+	    (comma-rx   (regexp ".*,.*"))
+	    (max-vals   '((min        . 60)
+			  (hour       . 24)
+			  (dayofmonth . 28) ;;; BUG!!!! This will be a bug for some combinations
+			  (month      . 12)
+			  (dayofweek  . 7))))
+	(if (< (length cron-items) 5) ;; bad spec
+	    cron-str ;; `(,cron-str)              ;; just return the string, something downstream will fix it
+	    (let loop ((hed  (car cron-items))
+		       (tal  (cdr cron-items))
+		       (type 'min)
+		       (type-tal '(hour dayofmonth month dayofweek))
+		       (res  '()))
+	      (regex-case
+		  hed
+		(slash-rx ( _ base incr ) (let* ((basen          (string->number base))
+						 (incrn          (string->number incr))
+						 (expanded-vals  (expand-cron-slash basen incrn (alist-ref type max-vals)))
+						 (new-list-crons (fold (lambda (x myres)
+									 (cons (conc (if (null? res)
+											 ""
+											 (conc (string-intersperse res " ") " "))
+										     x " " (string-intersperse tal " "))
+									       myres))
+								       '() expanded-vals)))
+					    ;; (print "new-list-crons: " new-list-crons)
+					    ;; (fold (lambda (x res)
+					    ;; 	    (if (list? x)
+					    ;; 		(let ((newres (map common:cron-expand x)))
+					    ;; 		  (append x newres))
+					    ;; 		(cons x res)))
+					    ;; 	  '()
+					    (flatten (map cron-expand new-list-crons))))
+		;;					    (map common:cron-expand (map common:cron-expand new-list-crons))))
+		(else (if (null? tal)
+			  cron-str
+			  (loop (car tal)(cdr tal)(car type-tal)(cdr type-tal)(append res (list hed)))))))))))
+		      
+	    
+;; given a cron string and the last time event was processed return #t to run or #f to not run
+;;
+;;  min    hour   dayofmonth month  dayofweek
+;; 0-59    0-23   1-31       1-12   0-6          ### NOTE: dayofweek does not include 7
+;;
+;;  #t => yes, run the job
+;;  #f => no, do not run the job
+;;
+(define (cron-event cron-str now-seconds-in last-done) ;; ref-seconds = #f is NOW.
+  (let* ((cron-items     (map string->number (string-split cron-str)))
+	 (now-seconds    (or now-seconds-in (current-seconds)))
+	 (now-time       (seconds->local-time now-seconds))
+	 (last-done-time (seconds->local-time last-done))
+	 (all-times      (make-hash-table)))
+    ;; (print "cron-items: " cron-items "(length cron-items): " (length cron-items))
+    (if (not (eq? (length cron-items) 5)) ;; don't even try to figure out junk strings
+	#f
+	(match-let (((     cmin chour cdayofmonth cmonth    cdayofweek)
+		     cron-items)
+		    ;; 0     1    2        3         4    5      6
+		    ((nsec nmin nhour ndayofmonth nmonth nyr ndayofweek n7 n8 n9)
+		     (vector->list now-time))
+		    ((lsec lmin lhour ldayofmonth lmonth lyr ldayofweek l7 l8 l9)
+		     (vector->list last-done-time)))
+	  ;; create all possible time slots
+	  ;; remove invalid slots due to (for example) day of week
+	  ;; get the start and end entries for the ref-seconds (current) time
+	  ;; if last-done > ref-seconds => this is an ERROR!
+	  ;; does the last-done time fall in the legit region?
+	  ;;    yes => #f  do not run again this command
+	  ;;    no  => #t  ok to run the command
+	  (for-each ;; month
+	   (lambda (month)
+	     (for-each ;; dayofmonth
+	      (lambda (dom)
+		(for-each
+		 (lambda (hr) ;; hour
+		   (for-each
+		    (lambda (minute) ;; minute
+		      (let ((copy-now (apply vector (vector->list now-time))))
+			(vector-set! copy-now 0 0) ;; force seconds to zero
+			(vector-set! copy-now 1 minute)
+			(vector-set! copy-now 2 hr)
+			(vector-set! copy-now 3 dom)  ;; dom is already corrected for zero referenced
+			(vector-set! copy-now 4 month)
+			(let* ((copy-now-secs (local-time->seconds copy-now))
+			       (new-copy      (seconds->local-time copy-now-secs))) ;; remake the time vector
+			  (if (or (not cdayofweek)
+				  (equal? (vector-ref new-copy 6)
+					  cdayofweek)) ;; if the day is specified and a match OR if the day is NOT specified
+			      (if (or (not cdayofmonth)
+				      (equal? (vector-ref new-copy 3)
+					      (+ 1 cdayofmonth))) ;; if the month is specified and a match OR if the month is NOT specified
+				  (hash-table-set! all-times copy-now-secs new-copy))))))
+		    (if cmin
+			`(,cmin)  ;; if given cmin, have to use it
+			(list (- nmin 1) nmin (+ nmin 1))))) ;; minute
+		 (if chour
+		     `(,chour)
+		     (list (- nhour 1) nhour (+ nhour 1))))) ;; hour
+	      (if cdayofmonth
+		  `(,cdayofmonth)
+		  (list (- ndayofmonth 1) ndayofmonth (+ ndayofmonth 1)))))
+	   (if cmonth
+	       `(,cmonth)
+	       (list (- nmonth 1) nmonth (+ nmonth 1))))
+	  (let ((before #f)
+		(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 (extended-cron  cron-str now-seconds-in last-done)
+  (let ((expanded-cron (cron-expand cron-str)))
+    (if (string? expanded-cron)
+	(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)
+	      #t
+	      (if (null? tal)
+		  #f
+		  (loop (car tal)(cdr tal))))))))
+
+(define (get-param-mapping #!key (flavor #f))
+  "returns alist mapping string keys in testconfig/subrun to megatest command line switches; if flavor is switch-symbol, maps tcmt symbolic switches to megatest switches"
+  (let ((default '(("tag-expr"  . "-tagexpr")
+                   ("mode-patt" . "-modepatt")
+                   ("run-name"  . "-runname")
+                   ("contour"   . "-contour")
+                   ("target"    . "-target")
+                   ("test-patt" . "-testpatt")
+                   ("msg"       . "-m")
+                   ("log"       . "-log")
+                   ("start-dir" . "-start-dir")
+                   ("new"       . "-set-state-status"))))
+    (if (eq? flavor 'switch-symbol)
+        (map (lambda (x)
+               (cons (string->symbol (conc "-" (car x))) (cdr x)))
+             default)
+        default)))
+
+
 
 )