Megatest

					   *start-run-offset* keypatts))
		 (header      (db:get-header allruns))
		 (runs        (db:get-rows   allruns))
		 (result      '())
		 (maxtests    0)
		 (states      (hash-table-keys *state-ignore-hash*))
		 (statuses    (hash-table-keys *status-ignore-hash*)))
	    ;; Instead of this mechanism lets try setting number of runs based on "result" below
	    (debug:print 2 "update-rundat, got " (length runs) " runs")
	    (if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes
		(begin
		  (set! *last-update* (current-seconds))
		  (set! *tot-run-count* (db:get-num-runs *db* runnamepatt))))
	    (for-each (lambda (run)
			(let* ((run-id   (db:get-value-by-header run header "id"))
			       (tests    (db-get-tests-for-run *db* run-id testnamepatt itemnamepatt states statuses))
			       (key-vals (get-key-vals *db* run-id)))
			  (if (> (length tests) maxtests)
			      (set! maxtests (length tests)))
			  (if (not (null? tests))
			      (set! result (cons (vector run tests key-vals) result)))))
			  ;(if (not (null? tests))
			      (set! result (cons (vector run tests key-vals) result)))); )
		      runs)
	    (set! *header*  header)
	    (set! *allruns* result)
	    (debug:print 2 "*allruns* has " (length *allruns*) " runs")
	    ;; (set! *tot-run-count* (+ 1 (length *allruns*)))
	    maxtests))
	*num-tests*))) ;; FIXME, naughty coding eh?

(define *collapsed* (make-hash-table))
; (define *row-lookup* (make-hash-table)) ;; testname => (rownum lableobj)

	  (iup:hbox
	   (iup:vbox
	    (iup:frame 
	     #:title "filter test and items"
	     (iup:hbox
	      (iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
			   #:action (lambda (obj unk val)
				      (set! *last-db-update-time* 0)
				      (update-search "test-name" val)))
	      (iup:textbox #:size "60x15" #:fontsize "10" #:value "%"
			   #:action (lambda (obj unk val)
				      (set! *last-db-update-time* 0)
				      (update-search "item-name" val)))))
	    (iup:hbox
	     (iup:button "Quit" #:action (lambda (obj)(sqlite3:finalize! *db*)(exit)))
	     ))
	   ;; (iup:button "<-  Left" #:action (lambda (obj)(set! *start-run-offset*  (+ *start-run-offset* 1))))
	   ;; (iup:button "Up     ^" #:action (lambda (obj)(set! *start-test-offset* (if (> *start-test-offset* 0)(- *start-test-offset* 1) 0))))
	   ;; (iup:button "Down   v" #:action (lambda (obj)(set! *start-test-offset* (if (>= *start-test-offset* (length *alltestnamelst*))(length *alltestnamelst*)(+ *start-test-offset* 1)))))

	      iup:hbox
	      (map (lambda (state)
		     (iup:toggle state   #:action   (lambda (obj val)
						      (set! *last-db-update-time* 0)
						      (if (eq? val 1)
							  (hash-table-set! *state-ignore-hash* state #t)
							  (hash-table-delete! *state-ignore-hash* state)))))
		   '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED")))))
	   (iup:valuator #:valuechanged_cb (lambda (obj)
					     (let ((val (inexact->exact (round (+ 0.0 (string->number (iup:attribute obj "VALUE"))))))
						   (maxruns  *tot-run-count*)) ;;; (+ *num-runs* (length *allruns*))))
					       (set! *start-run-offset* val)
					       (set! *last-db-update-time* 0)
					       (debug:print 3 "maxruns: " maxruns ", val: " val)
					       (iup:attribute-set! obj "MAX" maxruns)))
			 #:expand "YES"
		   '("RUNNING" "COMPLETED" "INCOMPLETE" "LAUNCHED" "NOT_STARTED" "KILLED")))
	     (iup:valuator #:valuechanged_cb (lambda (obj)
					       (let ((val (inexact->exact (round (/ (string->number (iup:attribute obj "VALUE")) 10))))
						     (oldmax   (string->number (iup:attribute obj "MAX")))
						     (maxruns  *tot-run-count*))
						 (set! *start-run-offset* val)
						 (set! *last-db-update-time* 0)
						 (debug:print 1 "*start-run-offset* " *start-run-offset* " maxruns: " maxruns ", val: " val " oldmax: " oldmax)
						 (iup:attribute-set! obj "MAX" (* maxruns 10))))
			   #:expand "YES"
			 #:max (+ ;; *num-runs*
				(length *allruns*)))
			   #:max (* 10 (length *allruns*)))))
	   ;(iup:button "inc rows" #:action (lambda (obj)(set! *num-tests* (+ *num-tests* 1))))
	   ;(iup:button "dec rows" #:action (lambda (obj)(set! *num-tests* (if (> *num-tests* 0)(- *num-tests* 1) 0))))
	   )
	  )
    
    ;; create the left most column for the run key names and the test names 
    (set! lftlst (list (iup:hbox
			(iup:label) ;; (iup:valuator)
			(apply iup:vbox 
			       (map (lambda (x)		
				      (let ((res (iup:hbox
						  (iup:label x #:size "40x15" #:fontsize "10") ;;  #:expand "HORIZONTAL")
						  (iup:textbox #:size "60x15" #:fontsize "10" #:value "%" ;; #:expand "HORIZONTAL"
							       #:action (lambda (obj unk val)
									  (set! *last-db-update-time* 0)
									  (update-search x val))))))
					(set! i (+ i 1))
					res))
				    keynames)))))
    (let loop ((testnum  0)
	       (res      '()))
      (cond
       ((>= testnum ntests)
	;; now lftlst will be an hbox with the test keys and the test name labels
	(set! lftlst (append lftlst (list (iup:hbox 
					   (iup:valuator #:valuechanged_cb (lambda (obj)
									     (let ((val (iup:attribute obj "VALUE")))
									     (let ((val (string->number (iup:attribute obj "VALUE")))
										   (oldmax  (string->number (iup:attribute obj "MAX")))
										   (newmax  (* 10 (length *alltestnamelst*))))
									       (set! *please-update-buttons* #t)
									       (set! *start-test-offset* (inexact->exact (round (string->number val))))
									       (iup:attribute-set! obj "MAX" (length *alltestnamelst*))
									       ) )
									       (set! *start-test-offset* (inexact->exact (round (/ val 10))))
									       (debug:print 1 "*start-test-offset* " *start-test-offset* " val: " val " newmax: " newmax " oldmax: " oldmax)
									       (if (< val 10)
										   (iup:attribute-set! obj "MAX" newmax))
									       ))
							 #:expand "YES" 
							 #:orientation "VERTICAL")
					   (apply iup:vbox (reverse res)))))))
       (else
	(let ((labl  (iup:button "" 
				 #:flat "YES" 
				 ; #:image img1

			  " ORDER BY event_time DESC "
			  (if (number? count)
			      (conc " LIMIT " count)
			      "")
			  (if (number? offset)
			      (conc " OFFSET " offset)
			      ""))))
    (debug:print 4 "db:get-runs qrystr: " qrystr "\nkeypatts: " keypatts)
    (debug:print 4 "db:get-runs qrystr: " qrystr "\nkeypatts: " keypatts "\n  offset: " offset " limit: " count)
    (sqlite3:for-each-row
     (lambda (a . x)
       (set! res (cons (apply vector a x) res)))
     db
     qrystr
     runpatt)
    (vector header res)))

     (conc "SELECT " keystr " FROM runs WHERE id=?;")
     run-id)
    (vector header res)))

(define (db:set-comment-for-run db run-id comment)
  (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id))

;; does not (obviously!) removed dependent data. 
(define (db:delete-run db run-id)
  (sqlite3:execute db "DELETE FROM runs WHERE id=?;" run-id))

(define (db:update-run-event_time db run-id)
  (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id)) 

;;======================================================================
;;  T E S T S
;;======================================================================

;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok

;;======================================================================
;; Extract ods file from the db
;;======================================================================

;; runspatt is a comma delimited list of run patterns
;; keypatt-alist must contain *all* keys with an associated pattern: '( ("KEY1" "%") .. )
(define (db:extract-ods-file db outputfile keypatt-alist runspatt)
(define (db:extract-ods-file db outputfile keypatt-alist runspatt pathmod)
  (let* ((keysstr  (string-intersperse (map car keypatt-alist) ","))
	 (keyqry   (string-intersperse (map (lambda (p)(conc (car p) " like ? ")) keypatt-alist) " AND "))
	 (numkeys  (length keypatt-alist))
	 (test-ids '())
	 (tempdir  (conc "/tmp/" (current-user-name) "/" runspatt "_" (random 10000) "_" (current-process-id)))
	 (runsheader (append (list "Run Id" "Runname")
			     (map car keypatt-alist)
			     (list "Testname" 
				   "Item Path"
				   "Description"
				   "State"
				   "Status"
				   "Final Log"
				   "Run Duration"
				   "When Run"
				   "Tags"
				   "Run Owner"
				   "Comment"
				   "Author"
				   "Test Owner"
				   "Reviewed"
				   "Diskfree"
				   "Uname"
				   "Rundir"
				   "Host"
				   "Cpu Load"
                                   "Warn"
                                   "Error")))
	 (results (list runsheader))
	 (runsheader (append (list "Run Id" "Runname") ; 0 1
			     (map car keypatt-alist)   ; + N = length keypatt-alist
			     (list "Testname"          ; 2
				   "Item Path"         ; 3 
				   "Description"       ; 4 
				   "State"             ; 5 
				   "Status"            ; 6  
				   "Final Log"         ; 7 
				   "Run Duration"      ; 8 
				   "When Run"          ; 9 
				   "Tags"              ; 10
				   "Run Owner"         ; 11
				   "Comment"           ; 12
				   "Author"            ; 13
				   "Test Owner"        ; 14
				   "Reviewed"          ; 15
				   "Diskfree"          ; 16
				   "Uname"             ; 17
				   "Rundir"            ; 18
				   "Host"              ; 19
				   "Cpu Load"          ; 20
                                   "Warn"              ; 21
                                   "Error")))          ; 22
	 (results (list runsheader))			 
	 (testdata-header (list "Run Id" "Testname" "Item Path" "Category" "Variable" "Value" "Expected" "Tol" "Units" "Status" "Comment")))
    (debug:print 2 "Using " tempdir " for constructing the ods file")
    ;; "Expected Value"
    ;; "Value Found"
    ;; "Tolerance"
    (apply sqlite3:for-each-row
     (lambda (test-id . b)
       (set! test-ids (cons test-id test-ids))   ;; test-id is now testname
       (set! results (append results (list b)))) ;; note, drop the test-id
       (set! results (append results ;; note, drop the test-id
			     (list
			      (if pathmod
				  (let* ((vb (apply vector b))
					 (testname  (vector-ref vb (+  2 numkeys)))
					 (item-path (vector-ref vb (+  3 numkeys)))
					 (final-log (vector-ref vb (+  7 numkeys)))
					 (run-dir   (vector-ref vb (+ 18 numkeys)))
					 (log-fpath (conc run-dir "/" testname "/" item-path "/" final-log)))
				    (debug:print 4 "log: " log-fpath " exists: " (file-exists? log-fpath))
				    (vector-set! vb (+ 7 numkeys) (if (file-exists? log-fpath)
								      (conc pathmod
									    "/" testname "/"
									    (if (string=? item-path "") "" (conc "/" item-path))
									    final-log)
								      (if (> *verbosity* 1)
									  (conc final-log " not-found")
									  "")))
				    (vector->list vb))
				  b)))))
     db
     (conc "SELECT
              t.testname,r.id,runname," keysstr ",t.testname,
              t.item_path,tm.description,t.state,t.status,
              final_logf,run_duration, 
              strftime('%m/%d/%Y %H:%M:%S',datetime(t.event_time,'unixepoch'),'localtime'),
              tm.tags,r.owner,t.comment,

	  db 
	  ;; "SELECT run_id,testname,item_path,category,variable,td.value AS value,expected,tol,units,td.status AS status,td.comment AS comment FROM test_data AS td INNER JOIN tests ON tests.id=td.test_id WHERE test_id=?;"
	  "SELECT run_id,testname,item_path,category,variable,td.value AS value,td.expected,td.tol,td.units,td.status AS status,td.comment AS comment FROM test_data AS td INNER JOIN tests ON tests.id=td.test_id WHERE testname=?;"
	  test-id)
	 (if curr-test-name
	     (set! results (append results (list (cons curr-test-name test-data)))))
	 ))
     (delete-duplicates test-ids))
     (sort (delete-duplicates test-ids) string<=))
    (system (conc "mkdir -p " tempdir))
    ;; (pp results)
    (ods:list->ods 
     tempdir
     (if (string-match (regexp "^[/~]+.*") outputfile) ;; full path?
	 outputfile
	 (begin
	   (debug:print 0 "WARNING: path given, " outputfile " is relative, prefixing with current directory")
	   (conc (current-directory) "/" outputfile)))
     results)))

;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")

;;======================================================================

;; ezsteps were going to be coded as
;; stepname[,predstep1,predstep2 ...] [{VAR1=first,second,third}] command to execute
;;   BUT
;; now are
;; stepname {VAR=first,second,third ...} command ...
;; where the {VAR=first,second,third ...} is optional.

;; given an exit code and whether or not logpro was used calculate OK/BAD
;; return #t if we are ok, #f otherwise
(define (steprun-good? logpro exitcode)
  (or (eq? exitcode 0)
      (and logpro (eq? exitcode 2))))

								   (mutex-unlock! m)
								   (if (eq? pid-val 0)
								       (begin
									 (thread-sleep! 2)
									 (processloop (+ i 1))))
								   ))
						     (teststep-set-status! db run-id test-name stepname "end" (vector-ref exit-info 2) itemdat #f)
						     (if logpro-used
							 (test-set-log! db run-id test-name itemdat (conc stepname ".html")))
						     (cond
						      ;; WARN from logpro
						      ((and (eq? (vector-ref exit-info 1) 2) logpro-used)
						       (test-set-status! db run-id test-name "COMPLETE" "WARN" itemdat "Logpro warning found" #f))
						      ((eq? (vector-ref exit-info 1) 0)
						       (test-set-status! db run-id test-name "COMPLETE" "PASS" itemdat #f #f))
						      (else

                            if -keepgoing is also specified)
  -rebuild-db             : bring the database schema up to date
  -rollup                 : fill run (set by :runname)  with latest test(s) from
                            prior runs with same keys
  -rename-run <runb>      : rename run (set by :runname) to <runb>, requires keys
  -update-meta            : update the tests metadata for all tests
  -extract-ods            : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
  -env2file fname         : write the environment to fname.csh and fname.sh

Helpers
  -runstep stepname  ...  : take remaining params as comand and execute as stepname
                            log will be in stepname.log. Best to put command in quotes
  -logpro file            : with -exec apply logpro file to stepname.log, creates
                            stepname.html and sets log to same

			":variable"
			":value"
			":expected"
			":tol"
			":units"
			;; misc
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-debug" ;; for *verbosity* > 2
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"

(if (args:get-arg "-extract-ods")
    (general-run-call
     "-extract-ods"
     "Make ods spreadsheet"
     (lambda (db keys keynames keyvallst)
       (let ((outputfile (args:get-arg "-extract-ods"))
	     (runspatt   (args:get-arg ":runname"))
	     (pathmod    (args:get-arg "-pathmod"))
	     (keyvalalist (keys->alist keys "%")))
	 (db:extract-ods-file db outputfile keyvalalist (if runspatt runspatt "%"))))))
	 (db:extract-ods-file db outputfile keyvalalist (if runspatt runspatt "%") pathmod)))))

;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory

	 
;; This could probably be refactored into one complex query ...
(define (runs:rollup-run db keys)
  (let* ((new-run-id      (register-run db keys))
	 (prev-tests      (test:get-matching-previous-test-run-records db new-run-id "%" "%"))
	 (curr-tests      (db-get-tests-for-run db new-run-id "%" "%" '() '()))
	 (curr-tests-hash (make-hash-table)))
    (db:update-run-event_time db new-run-id)
    ;; index the already saved tests by testname and itempath in curr-tests-hash
    (for-each
     (lambda (testdat)
       (let* ((testname  (db:test-get-testname testdat))
	      (item-path (db:test-get-item-path testdat))
	      (full-name (conc testname "/" item-path)))
	 (hash-table-set! curr-tests-hash full-name testdat)))

# run some tests

MEGATEST=$(shell realpath ../megatest)

runall :
	cd ../;make 
	$(MEGATEST) -keepgoing -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +%GWW%V.%u` -m "This is a comment specific to a run" -v
	$(MEGATEST) -keepgoing -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +w%V.%u.%H` -m "This is a comment specific to a run" -v

test :
	csi -b -I .. ../megatest.scm -- -runall :sysname ubuntu :fsname afs :datapath tmp :runname blah
	cd ../;make test
	make runall

dashboard :

;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com
;;  
;;   License GPL.

;; define your hooks
(hook:first-error   "echo \"Error hook activated: #{escaped errmsg}\"")
(hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"")
(hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"")

;; first ensure your run at least started
;;
(trigger "Init"     #/This is a header/)
(trigger "InitEnd"  #/^\s*$/)
(section "Init" "Init" "InitEnd")

(trigger "Body"     #/^.*$/) ;; anything starts the body
;; (trigger "EndBody"  #/This had better never match/)

(section "Body"     "Body" "EndBody")

(trigger "Blah2"    #/^begin Blah2/)
(trigger "Blah2End" #/^end Blah2/)
(section "Blah2"    "Blah2" "Blah2End")

(expect:required in "Init"  = 1 "Header"      #/This is a header/)
(expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/)
(expect:value    in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/)
(expect:value    in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/)
(expect:value    in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/)
(expect:value    in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/)
(expect:value    in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/)

;; Using match number
(expect:value    in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2)

;; Comparison instead of tolerance
(expect:value    in "LogFileBody" 1.9 >   "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2)

(expect:ignore   in "Blah2" < 99 "FALSE ERROR" #/ERROR/)
(expect:ignore   in "Body"  < 99 "Ignore the word error in comments" #/^\/\/.*error/)
(expect:warning  in "Body"  = 0 "Any warning" #/WARNING/)
(expect:error    in "Body"  = 0 "ERROR BLAH"  (list #/ERROR/ #/error/)) ;; but disallow any other errors

;(expect in "Init"  < 1 "Junk"        #/This is bogus/)

[setup]

[ezsteps]
lookittmp   ls /tmp
lookithome  ls /home

[test_meta]
author matt
owner  bob
description This test runs a single ezstep which is expected to pass, no logpro file.

tags first,single
reviewed 09/10/2011, by Matt