@@ -121,30 +121,50 @@
 ;; used in simple-get-runs (thanks Brandon!)
 (define-record simple-run target id runname state status owner event_time)
 (define-record-printer (simple-run x out)
   (fprintf out "#,(simple-run ~S ~S ~S ~S)"
 	   (simple-run-target x) (simple-run-id x) (simple-run-runname x) (time->string (seconds->local-time (simple-run-event_time x) ))))
+
+;; args is hash table of string to value
+;;
+(define (get-purpose args)
+  (let* ((get-arg    (lambda (key)
+		       (hash-table-ref/default args key #f)))
+	 (get-switch (lambda keys
+		       (fold
+			(lambda (key res)
+			  (if (hash-table-ref/default args key #f)
+			      (or key res)
+			      res))
+			#f
+			keys)))
+	 (action     (get-switch "-server" "-execute" "-run" "-rerun")))
+    (cond
+     (action
+      (substring action 1 (string-length action)))
+     (else
+      "nopurpose"))))
 
 ;; megatest process tracking
 
-(defstruct pinf
-  (start (current-seconds))
-  (host  (get-host-name)) ;; why is this not being recognised?
-  (pid   (current-process-id))
-  (port  #f)
-  (cwd   (current-directory))
-  (load   #f)
-  (purpose #f) ;; get-purpose needed
-  (dbname   #f)
-  (mtbin (car (argv)))
-  (mtversion #f)
-  (status   "running")
+(defstruct procinf
+  (start      (current-seconds))
+  (host       (get-host-name)) ;; why is this not being recognised?
+  (pid        (current-process-id))
+  (port       #f)
+  (cwd        (current-directory))
+  (load       #f)
+  (purpose    #f) ;; get-purpose needed to be run in megatest.scm
+  (dbname     #f)
+  (mtbin      (car (argv)))
+  (mtversion  #f)
+  (status     "running")
   
   
   )
 
-(define *pinf* (make-pinf))
+(define *procinf* (make-procinf))
 (define *dbstruct-dbs* #f)
 (define *db-open-mutex* (make-mutex))
 (define *db-access-mutex* (make-mutex)) ;; used in common.scm
 (define *no-sync-db*   #f)
 (define *db-sync-in-progress* #f)
@@ -515,41 +535,41 @@
     db))
 
 ;; mtest processes registry calls
 
 (define (dbfile:insert-or-update-process nsdb dat)
-  (let* ((host  (pinf-host dat))
-	 (pid   (pinf-pid  dat))
+  (let* ((host      (procinf-host dat))
+	 (pid       (procinf-pid  dat))
 	 (curr-info (dbfile:get-process-info nsdb host pid)))
     (if curr-info ;; record exists, do update
 	(match curr-info
 	  ((host port pid starttime status purpose dbname mtversion)
 	   (sqlite3:execute
 	    nsdb
 	    "UPDATE processes SET port=?,starttime=?,status=?,
                                   purpose=?,dbname=?,mtversion=?
               WHERE host=? AND pid=?;"
-	    (or (pinf-port      dat) port)
-	    (or (pinf-start     dat) starttime)
-	    (or (pinf-status    dat) status)
-	    (or (pinf-purpose   dat) purpose)
-	    (or (pinf-dbname    dat) dbname)
-	    (or (pinf-mtversion dat) mtversion)
+	    (or (procinf-port      dat) port)
+	    (or (procinf-start     dat) starttime)
+	    (or (procinf-status    dat) status)
+	    (or (procinf-purpose   dat) purpose)
+	    (or (procinf-dbname    dat) dbname)
+	    (or (procinf-mtversion dat) mtversion)
 	    host pid))
 	  (else
 	   #f ;; what to do?
 	   ))
 	(dbfile:register-process
 	 nsdb
-	 (pinf-host      dat)
-	 (pinf-port      dat)
-	 (pinf-pid       dat)
-	 (pinf-start     dat)
-	 (pinf-status    dat)
-	 (pinf-purpose   dat)
-	 (pinf-dbname    dat)
-	 (pinf-mtversion dat)))))
+	 (procinf-host      dat)
+	 (procinf-port      dat)
+	 (procinf-pid       dat)
+	 (procinf-start     dat)
+	 (procinf-status    dat)
+	 (procinf-purpose   dat)
+	 (procinf-dbname    dat)
+	 (procinf-mtversion dat)))))
 	  
 
 (define (dbfile:register-process nsdb host port pid starttime status purpose dbname mtversion)
   (sqlite3:execute nsdb "INSERT INTO processes (host,port,pid,starttime,status,purpose,dbname,mtversion) VALUES (?,?,?,?,?,?,?,?);"
 		   host port pid starttime status purpose dbname mtversion))