@@ -17,11 +17,13 @@
 ;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;======================================================================
 
 (declare (unit genexample))
-(use posix regex)
+(use posix regex matchable)
+
+(include "db_records.scm")
 
 (define genexample:example-logpro
 #<<EOF
   ;; You should have at least one expect:required. This ensures that your process ran
   ;; comment out the line below and replace "put pattern here" with a pattern that will
@@ -338,5 +340,99 @@
 			      (with-output-to-file (conc testdir "/" script)
 				(lambda ()
 				  (print genexample:example-script)))
 			      (system (conc "chmod ug+r,a+x " (conc testdir "/" script)))))))
 		    steps))))))
+
+;; easier to work backwards than change the upstream code
+;;
+(define (hrs-min-sec->seconds str)
+  (let* ((parts (string-split str))
+	 (res   0))
+    (for-each
+     (lambda (part)
+       (set! res
+	     (+ res
+		(match (string-match "(\\d+)([a-z])" part)
+		  ((_ val units)(* (string->number val)(case (string->symbol units)
+							 ((s) 1)
+							 ((m) 60)
+							 ((h) 3600))))
+		  (else 0)))))
+     parts)
+    res))
+
+;; generate a skeleton Megatest area from a current area with runs
+;;
+;;    specify target, runname etc to use specific runs for the template
+;;
+(define (genexample:extract-skeleton-area dest-path)
+  (let* ((target  (args:get-arg "-target"))
+	 (runname (args:get-arg "-runname"))
+	 )
+    (if (not (and target runname))
+	(debug:print 0 *default-log-port* "WARNING: For best results please specifiy -target and -runname for a good run to use as a template."))
+    (if (not (and (file-exists? "megatest.config")
+		  (file-exists? "megatest.db")))
+	(begin
+	  (debug:print 0 *default-log-port* "ERROR: this command must be run at the top level of a megatest area where runs have been completed")
+	  (exit)))
+	     
+    ;; first create the dest path and needed subdirectories
+    (if (not (file-exists? dest-path))
+	(begin
+	  (create-directory dest-path)
+	  (create-directory (conc dest-path "/tests")))
+	(if (file-exists? (conc dest-path "/megatest.config"))
+	    (begin
+	      (debug:print 0 *default-log-port* "ERROR: destination path already has megatest.config, stopping now.")
+	      (exit))))
+
+    ;; dump the config files from this area to the dest area
+    (system (conc "megatest -show-config > " dest-path "/megatest.config"))
+    (system (conc "megatest -show-runconfig > " dest-path "/runconfigs.config"))
+
+    ;; create a refdb, some stuff has to be done due to refdb not initing area
+    ;;   sheet   row       col      value
+    ;;   test    itempath  stepname steptime
+    (if (not (file-exists? (conc dest-path "/stepsinfo")))
+	(begin
+	  (create-directory (conc dest-path "/stepsinfo/sxml") #t)
+	  (with-output-to-file (conc dest-path "/stepsinfo/sheet-names.cfg") (lambda ()(print)))))
+
+    ;; rmt:get-tests-for-run
+    ;; rmt:get-tests-for-run-mindata run-id testpatt states status not-in
+    ;; rmt:simple-get-runs
+    ;; (define-record simple-run target id runname state status owner event_time)
+    (let* ((runs   (rmt:simple-get-runs (or runname "%") #f #f (or target "%")))
+	   (tests  (make-hash-table))
+	   (refdb  (conc dest-path "/stepsinfo")))
+      (if (> (length runs) 1)
+	  (debug:print-info 0 *default-log-port* "More than one run matches, first found data will be used."))
+      ;; get all testnames
+      (for-each
+       (lambda (run-id)
+	 (let* ((tests-data (rmt:get-tests-for-run-mindata run-id "%" '() '() #f)))
+	   (for-each
+	    (lambda (testdat)
+	      (let* ((test-id      (db:mintest-get-id testdat))
+		     (testname     (db:mintest-get-testname testdat))
+		     (item-path    (db:mintest-get-item_path testdat))
+		     ;; now get steps info
+		     (test-steps   (tests:get-compressed-steps run-id test-id)))
+		(if (not (hash-table-exists? tests testname))
+		    (begin
+		      (print "\n" testname)
+		      (for-each
+		       (lambda (teststep)
+			 (let* ((step-name     (vector-ref teststep 0))
+				(step-duration (hrs-min-sec->seconds (vector-ref teststep 4))))
+			   (system (conc "refdb set " refdb " " testname " '" (if (equal? item-path "")
+										  "no-item-path"
+										  item-path)
+					 "' " step-name " " step-duration))
+			   ))
+		       test-steps))
+		    (else (debug:print-info 0 *default-log-port* "Skipping already seen test " testname)))))
+	    tests-data)))
+       (map (lambda (runrec)(simple-run-id runrec)) runs)))
+    ))