@@ -414,10 +414,12 @@
 (define home (getenv "HOME"))
 (define user (getenv "USER"))
 
 ;;======================================================================
 ;; return a nice clean pathname made absolute
+;;======================================================================
+
 (define (common:nice-path dir)
   (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
     (if match ;; using ~ for home?
 	(common:nice-path (conc (common:read-link-f (cadr match)) "/" (caddr match)))
 	(normalize-pathname (if (absolute-pathname? dir)
@@ -493,11 +495,12 @@
 
 ;;======================================================================
 ;; does the directory exist and do we have write access?
 ;;
 ;;    returns the directory or #f
-;;
+;;======================================================================
+
 (define (common:directory-writable? path-string)
   (handle-exceptions
       exn
     (begin
       (debug:print 0 *default-log-port* "Failed to identify access to " path-string ", exn=" exn)
@@ -592,10 +595,88 @@
     (delete-file* fname)))
 
 ;;======================================================================
 ;; misc conversion, data manipulation functions
 ;;======================================================================
+
+;;======================================================================
+;; old stuff from keys.scm
+;;======================================================================
+
+(include "key_records.scm")
+(include "common_records.scm")
+
+(define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
+  (string-intersperse keys ","))
+
+;; (define (args:usage . a) #f)
+
+(define (tasks:wait-on-journal path n #!key (remove #f)(waiting-msg #f))
+  (if (not (string? path))
+      (debug:print-error 0 *default-log-port* "Called tasks:wait-on-journal with path=" path " (not a string)")
+      (let ((fullpath (conc path "-journal")))
+	(handle-exceptions
+	 exn
+	 (begin
+	   (print-call-chain (current-error-port))
+	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
+	   (debug:print 5 *default-log-port* " exn=" (condition->list exn))
+	   (debug:print 0 *default-log-port* "tasks:wait-on-journal failed. Continuing on, you can ignore this call-chain")
+	   #t) ;; if stuff goes wrong just allow it to move on
+	 (let loop ((journal-exists (file-exists? fullpath))
+		    (count          n)) ;; wait ten times ...
+	   (if journal-exists
+	       (begin
+		 (if (and waiting-msg
+			  (eq? (modulo n 30) 0))
+		     (debug:print 0 *default-log-port* waiting-msg))
+		 (if (> count 0)
+		     (begin
+		       (thread-sleep! 1)
+		       (loop (file-exists? fullpath)
+			     (- count 1)))
+		     (begin
+		       (debug:print 0 *default-log-port* "ERROR: removing the journal file " fullpath ", this is not good. Look for disk full, write access and other issues.")
+		       (if remove (system (conc "rm -rf " fullpath)))
+		       #f)))
+	       #t))))))
+
+;;======================================================================
+;; key <=> target routines
+;;======================================================================
+
+;; This invalidates using "/" in item names. Every key will be
+;; available via args:get-arg as :keyfield. Since this only needs to
+;; be called once let's use it to set the environment vars
+;;
+;; The setting of :keyfield in args should be turned off ASAP
+;;
+(define (keys:target-set-args keys target ht)
+  (if target
+      (let ((vals (string-split target "/")))
+	(if (eq? (length vals)(length keys))
+	    (for-each (lambda (key val)
+			(setenv key val)
+			(if ht (hash-table-set! ht (conc ":" key) val)))
+		      keys
+		      vals)
+	    (debug:print-error 0 *default-log-port* "wrong number of values in " target ", should match " keys))
+	vals)
+      (debug:print 4 *default-log-port* "ERROR: keys:target-set-args called with no target.")))
+
+;; given the keys (a list of vectors <key field> or a list of keys) and a target return a keyval list
+;; keyval list ( (key1 val1) (key2 val2) ...)
+(define (keys:target->keyval keys target)
+  (let* ((targlist (string-split target "/"))
+	 (numkeys  (length keys))
+	 (numtarg  (length targlist))
+	 (targtweaked (if (> numkeys numtarg)
+			  (append targlist (make-list (- numkeys numtarg) ""))
+			  targlist)))
+    (map (lambda (key targ)
+	   (list key targ))
+	 keys targtweaked)))
 
 ;;======================================================================
 ;; return first command that exists, else #f
 ;;
 (define (common:which cmds)
@@ -2500,9 +2581,130 @@
 	       (debug:print 0 *default-log-port* "joining threads failed. exn=" exn)
                #t) ;; just ignore it, it might have died in the meantime so joining it will throw an exception
              (thread-join! thread))
            )))
    (hash-table-keys *common:thread-punchlist*)))
+
+;; given a list of itemmaps (testname . map), return the first match
+;;
+(define (tests:lookup-itemmap itemmaps testname)
+  (let ((best-matches (filter (lambda (itemmap)
+				(tests:match (car itemmap) testname #f))
+			      itemmaps)))
+    (if (null? best-matches)
+	#f
+	(let ((res (car best-matches)))
+	  ;; (debug:print 0 *default-log-port* "res=" res)
+	  (cond
+	   ((string? res) res) ;;; FIX THE ROOT CAUSE HERE ....
+	   ((null? res)   #f)
+	   ((string? (cdr res)) (cdr res))  ;; it is a pair
+	   ((string? (cadr res))(cadr res)) ;; it is a list
+	   (else cadr res))))))
+
+;; if itempath is #f then look only at the testname part
+;;
+(define (tests:match patterns testname itempath #!key (required '()))
+  (if (string? patterns)
+      (let ((patts (append (string-split patterns ",") required)))
+	(if (null? patts) ;;; no pattern(s) means no match
+	    #f
+	    (let loop ((patt (car patts))
+		       (tal  (cdr patts)))
+	      ;; (print "loop: patt: " patt ", tal " tal)
+	      (if (string=? patt "")
+		  #f ;; nothing ever matches empty string - policy
+		  (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
+			 (test-patt  (cadr patt-parts))
+			 (item-patt  (cadddr patt-parts)))
+		    ;; special case: test vs. test/
+		    ;;   test  => "test" "%"
+		    ;;   test/ => "test" ""
+		    (if (and (not (substring-index "/" patt)) ;; no slash in the original
+			     (or (not item-patt)
+				 (equal? item-patt "")))      ;; should always be true that item-patt is ""
+			(set! item-patt "%"))
+		    ;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
+		    (if (and (tests:glob-like-match test-patt testname)
+			     (or (not itempath)
+				 (tests:glob-like-match (if item-patt item-patt "") itempath)))
+			#t
+			(if (null? tal)
+			    #f
+			    (loop (car tal)(cdr tal)))))))))))
+
+;; if itempath is #f then look only at the testname part
+;;
+(define (tests:match->sqlqry patterns)
+  (if (string? patterns)
+      (let ((patts (string-split patterns ",")))
+	(if (null? patts) ;;; no pattern(s) means no match, we will do no query
+	    #f
+	    (let loop ((patt (car patts))
+		       (tal  (cdr patts))
+		       (res  '()))
+	      ;; (print "loop: patt: " patt ", tal " tal)
+	      (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
+		     (test-patt  (cadr patt-parts))
+		     (item-patt  (cadddr patt-parts))
+		     (test-qry   (db:patt->like "testname" test-patt))
+		     (item-qry   (db:patt->like "item_path" item-patt))
+		     (qry        (conc "(" test-qry " AND " item-qry ")")))
+		;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
+		(if (null? tal)
+		    (string-intersperse (append (reverse res)(list qry)) " OR ")
+		    (loop (car tal)(cdr tal)(cons qry res)))))))
+      #f))
+
+(define *glob-like-match-cache* (make-hash-table))
+(define (tests:cache-regexp str-in flag)
+  (let* ((key (conc str-in flag)))
+    (or (hash-table-ref/default *glob-like-match-cache* key #f)
+	(let* ((newrx (regexp str-in flag)))
+	  (hash-table-set! *glob-like-match-cache* key newrx)
+	  newrx))))
+
+;; tests:glob-like-match 
+(define (tests:glob-like-match patt str) 
+  (let* ((like     (substring-index "%" patt))
+	 (notpatt  (equal? (substring-index "~" patt) 0))
+	 (newpatt  (if notpatt (substring patt 1) patt))
+	 (finpatt  (if like
+		       (string-substitute (regexp "%") ".*" newpatt #f)
+		       (string-substitute (regexp "\\*") ".*" newpatt #f)))
+	 (rx       (tests:cache-regexp finpatt (if like #t #f)))
+	 (res      (string-match rx str)))
+    (if notpatt (not res) res)))
+
+;; keys list to key1,key2,key3 ...
+(define (runs:get-std-run-fields keys remfields)
+  (let* ((header    (append keys remfields))
+	 (keystr    (conc (keys->keystr keys) ","
+			  (string-intersperse remfields ","))))
+    (list keystr header)))
+
+;; make a query (fieldname like 'patt1' OR fieldname 
+(define (db:patt->like fieldname pattstr #!key (comparator " OR "))
+  (let ((patts (if (string? pattstr)
+		   (string-split pattstr ",")
+		   '("%"))))
+    (string-intersperse (map (lambda (patt)
+			       (let ((wildtype (if (substring-index "%" patt) "LIKE" "GLOB")))
+				 (conc fieldname " " wildtype " '" patt "'")))
+			     (if (null? patts)
+				 '("")
+				 patts))
+			comparator)))
+
+;;======================================================================
+;; V E R S I O N
+;;======================================================================
+
+(define (common:get-full-version)
+  (conc megatest-version "-" megatest-fossil-hash))
+
+(define (common:version-signature)
+  (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))
 
 
 
 )