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*)))
	    (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)))); )
		      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 (/ (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 (* 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 (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 (/ 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 "\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 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") ; 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 ;; 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)))))
	 ))
     (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 "%") 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 +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