Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -327,21 +327,58 @@
 			    (set! freespc newval))))))
 	      (car df-results))
     freespc))
   
 (define (get-cpu-load)
-  (let* ((load-res (cmd-run->list "uptime"))
-	 (load-rx  (regexp "load average:\\s+(\\d+)"))
-	 (cpu-load #f))
-    (for-each (lambda (l)
-		(let ((match (string-search load-rx l)))
-		  (if match
-		      (let ((newval (string->number (cadr match))))
-			(if (number? newval)
-			    (set! cpu-load newval))))))
-	      (car load-res))
-    cpu-load))
+  (car (common:get-cpu-load)))
+;;   (let* ((load-res (cmd-run->list "uptime"))
+;; 	 (load-rx  (regexp "load average:\\s+(\\d+)"))
+;; 	 (cpu-load #f))
+;;     (for-each (lambda (l)
+;; 		(let ((match (string-search load-rx l)))
+;; 		  (if match
+;; 		      (let ((newval (string->number (cadr match))))
+;; 			(if (number? newval)
+;; 			    (set! cpu-load newval))))))
+;; 	      (car load-res))
+;;     cpu-load))
+
+;; get cpu load by reading from /proc/loadavg, return all three values
+;;
+(define (common:get-cpu-load)
+  (with-input-from-file "/proc/loadavg" 
+    (lambda ()(list (read)(read)(read)))))
+
+(define (common:wait-for-cpuload maxload numcpus waitdelay #!key (count 1000))
+  (let* ((loadavg (common:get-cpu-load))
+	 (first   (car loadavg))
+	 (next    (cadr loadavg))
+	 (adjload (* maxload numcpus))
+	 (loadjmp (- first next)))
+    (cond
+     ((and (> first adjload)
+	   (> count 0))
+      (print "waiting " waitdelay " seconds due to load " first " exceeding max of " adjload)
+      (thread-sleep! waitdelay)
+      (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1)))
+     ((and (> loadjmp numcpus)
+	   (> count 0))
+      (print "waiting " waitdelay " seconds due to load jump " loadjmp " > numcpus " numcpus)
+      (thread-sleep! waitdelay)
+      (common:wait-for-cpuload maxload numcpus waitdelay count: (- count 1))))))
+
+(define (common:get-num-cpus)
+  (with-input-from-file "/proc/cpuinfo"
+    (lambda ()
+      (let loop ((numcpu 0)
+		 (inl    (read-line)))
+	(if (eof-object? inl)
+	    numcpu
+	    (loop (if (string-match "^processor\\s+:\\s+\\d+$" inl)
+		      (+ numcpu 1)
+		      numcpu)
+		  (read-line)))))))
 
 (define (get-uname . params)
   (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params)))))
 	 (uname #f))
     (if (null? (car uname-res))

Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -583,11 +583,15 @@
 	 (max-concurrent-jobs     (list-ref run-limits-info 3))
 	 (job-group-limit         (list-ref run-limits-info 4))
 	 (prereqs-not-met         (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap))
 	 (fails                   (runs:calc-fails prereqs-not-met))
 	 (non-completed           (runs:calc-not-completed prereqs-not-met))
-	 (loop-list               (list hed tal reg reruns)))
+	 (loop-list               (list hed tal reg reruns))
+	 ;; configure the load runner
+	 (numcpus                 (common:get-num-cpus))
+	 (maxload                 (string->number (or (configf:lookup *configdat* "jobtools" "maxload") "3")))
+	 (waitdelay               (string->number (or (configf:lookup *configdat* "jobtools" "waitdelay") "60"))))
     (debug:print-info 4 "have-resources: " have-resources " prereqs-not-met: (" 
 		      (string-intersperse 
 		       (map (lambda (t)
 			      (if (vector? t)
 				  (conc (db:test-get-state t) "/" (db:test-get-status t))
@@ -682,10 +686,14 @@
 		    (null? non-completed))))
       ;; (hash-table-delete! *max-tries-hash* (runs:make-full-test-name test-name item-path))
       ;; we are going to reset all the counters for test retries by setting a new hash table
       ;; this means they will increment only when nothing can be run
       (set! *max-tries-hash* (make-hash-table))
+      ;; well, first lets see if cpu load throttling is enabled. If so wait around until the
+      ;; average cpu load is under the threshold before continuing
+      (if (configf:lookup *configdat* "jobtools" "maxload") ;; only gate if maxload is specified
+	  (common:wait-for-cpuload maxload numcpus waitdelay))
       (run:test run-id run-info keyvals runname test-record flags #f test-registry all-tests-registry)
       (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'running)
       (runs:shrink-can-run-more-tests-count)  ;; DELAY TWEAKER (still needed?)
       ;; (thread-sleep! *global-delta*)
       (if (or (not (null? tal))(not (null? reg)))

Index: tests/fullrun/config/mt_include_1.config
==================================================================
--- tests/fullrun/config/mt_include_1.config
+++ tests/fullrun/config/mt_include_1.config
@@ -12,11 +12,17 @@
 # launcher exec nbfake
 # launcher nbfake
 # launcher echo
 # launcher nbfind
 # launcher nodanggood
-launcher loadrunner
+# launcher loadrunner
+launcher nbfake
+# maxload *per cpu*
+maxload 4
+# default waitdelay is 60 seconds
+waitdelay 15
+
 
 ## use "xterm -e csi -- " as a launcher to examine the launch environment.
 ## exit with (exit)
 ## get a shell with (system "bash")
 # launcher xterm -e csi --

ADDED   utils/loadrunner.scm.notfinished
Index: utils/loadrunner.scm.notfinished
==================================================================
--- /dev/null
+++ utils/loadrunner.scm.notfinished
@@ -0,0 +1,192 @@
+
+;; Copyright 2006-2013, Matthew Welland.
+;; 
+;;  This program is made available under the GNU GPL version 2.0 or
+;;  greater. See the accompanying file COPYING for details.
+;; 
+;;  This program is distributed WITHOUT ANY WARRANTY; without even the
+;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+;;  PURPOSE.
+
+(use ssax)
+(use sxml-serializer)
+(use sxml-modifications)
+(use regex)
+(use srfi-69)
+(use regex-case)
+(use posix)
+(use json)
+(use csv)
+(use srfi-18)
+(use format)
+
+(require-library iup)
+(import (prefix iup iup:))
+(require-library ini-file)
+(import (prefix ini-file ini:))
+
+(use canvas-draw)
+(import canvas-draw-iup)
+
+(use sqlite3 srfi-1 posix regex regex-case srfi-69)
+(import (prefix sqlite3 sqlite3:))
+
+(include "megatest-fossil-hash.scm")
+
+;;
+;; GLOBALS
+;;
+(define *loadrunner:current-tab-number* 0)
+(define loadrunner:unrecognised-command "ERROR: Unrecognised command or missing params. Try \"loadrunner help\"")
+(define loadrunner:help (conc "Usage: loadrunner [action [params ...]]
+
+Note: run loadrunner without parameters to start the gui.
+
+  run cmd [params ..]   : Run cmd params ... when system load drops
+  process               : Process the queue
+
+Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest
+
+Version: " megatest-fossil-hash)) ;; "
+
+;;======================================================================
+;; DB
+;;======================================================================
+
+(define (loadrunner:initialize-db db)
+  (for-each
+   (lambda (qry)
+     (sqlite3:execute db qry))
+   (list 
+    "CREATE TABLE pkgs 
+         (id        INTEGER PRIMARY KEY,
+          cmd       TEXT,
+          datetime  TEXT);")))
+
+;; Create the sqlite db
+(define (loadrunner:open-db path) 
+  (if (and path
+	   (directory? path)
+	   (file-read-access? path))
+      (let* ((dbpath    (conc path "/loadrunner.db"))
+	     (writeable (file-write-access? dbpath))
+	     (dbexists  (file-exists? dbpath))
+	     (handler   (make-busy-timeout 136000)))
+	(handle-exceptions
+	 exn
+	 (begin
+	   (debug:print 2 "ERROR: problem accessing db " dbpath
+			((condition-property-accessor 'exn 'message) exn))
+	   (exit))
+	 (set! db (sqlite3:open-database dbpath)))
+	(if *db-write-access* (sqlite3:set-busy-handler! db handler))
+	(if (not dbexists)
+	    (begin
+	      (loadrunner:initialize-db db)))
+	db)))
+
+;;======================================================================
+;; GUI
+;;======================================================================
+
+;; The main menu 
+(define (loadrunner:main-menu)
+  (iup:menu ;; a menu is a special attribute to a dialog (think Gnome putting the menu at screen top)
+   (iup:menu-item "Files" (iup:menu   ;; Note that you can use either #:action or action: for options
+		       (iup:menu-item "Open"  action: (lambda (obj)
+							(iup:show (iup:file-dialog))
+							(print "File->open " obj)))
+		       (iup:menu-item "Save"  #:action (lambda (obj)(print "File->save " obj)))
+		       (iup:menu-item "Exit"  #:action (lambda (obj)(exit)))))
+   (iup:menu-item "Tools" (iup:menu
+		       (iup:menu-item "Create new blah" #:action (lambda (obj)(print "Tools->new blah")))
+		       ;; (iup:menu-item "Show dialog"     #:action (lambda (obj)
+		       ;;  					   (show message-window
+		       ;;  					     #:modal? #t
+		       ;;  					     ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
+		       ;;  					     ;; #:x 'mouse
+		       ;;  					     ;; #:y 'mouse
+		       ;;  )					     
+		       ))))
+
+(define (loadrunner:publish-view)
+  (iup:vbox
+   (iup:hbox 
+    (iup:button "Pushme" 
+		#:expand "YES"
+		))))
+
+(define (loadrunner:get-view)
+  (iup:vbox
+   (iup:hbox 
+    (iup:button "Pushme"
+		#:expand "YES"
+		))))
+
+(define (loadrunner:manage-view)
+  (iup:vbox
+   (iup:hbox 
+    (iup:button "Pushme"
+		#:expand "YES"
+		))))
+
+(define (loadrunner:gui)
+  (iup:show
+   (iup:dialog 
+    #:title (conc "Loadrunner dashboard " (current-user-name) ":" (current-directory))
+    #:menu (loadrunner:main-menu)
+    (let* ((tabs (iup:tabs
+		  #:tabchangepos-cb (lambda (obj curr prev)
+				      (set! *loadrunner:current-tab-number* curr))
+		  (loadrunner:publish-view)
+		  (loadrunner:get-view)
+		  (loadrunner:manage-view)
+		  )))
+	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
+	(iup:attribute-set! tabs "TABTITLE0" "Publish")
+	(iup:attribute-set! tabs "TABTITLE1" "Get")
+	(iup:attribute-set! tabs "TABTITLE2" "Manage")
+	;; (iup:attribute-set! tabs "BGCOLOR" "190 190 190")
+	tabs)))
+  (iup:main-loop))
+
+;;======================================================================
+;; MAIN
+;;======================================================================
+
+(define (loadrunner:load-config path)
+  (let ((fname (conc path "/.loadrunner.config")))
+    (ini:property-separator-patt " *  *")
+    (ini:property-separator #\space)
+    (if (file-exists? fname)
+	(ini:read fname)
+	'())))
+
+(define (main)
+  (let* ((args (argv))
+	 (prog (car args))
+	 (rema (cdr args))
+	 (conf (loadrunner:load-config (pathname-directory prog))))
+    ;; (    ?????
+    (cond
+     ((eq? (length rema) 1)
+      (case (string->symbol (car rema))
+	((process)(loadrunner:process-queue))
+	((pause)
+	 (loadrunner:pause-queue (cdr rema)))
+	((help -h -help --h --help)
+	 (print loadrunner:help))
+	(else
+	 (print loadrunner:unrecognised-command))))
+     ((null? rema)(loadrunner:gui))
+     ((>= (length rema) 2)
+      (case (string->symbol (car rema))
+	((run)
+	 (loadrunner:process-cmd (cdr rema)))
+	((remove)
+	 (loadrunner:remove-cmds (cdr rema)))
+	(else
+	 (print loadrunner:unrecognised-command))))
+     (else (print loadrunner:unrecognised-command)))))
+
+(main)