Megatest

Check-in [9940aff1c0]
Login
Overview
Comment:Completed couple things for ods file extraction
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | v1.24
Files: files | file ages | folders
SHA1: 9940aff1c0dfcb813a42fba37f284169eb4ad316
User & Date: mrwellan on 2011-09-08 15:10:47
Other Links: manifest | tags
Context
2011-09-08
20:56
Partial moved all values, expected, tol, units to test_data check-in: b846d139bd user: mrwellan tags: trunk
15:10
Completed couple things for ods file extraction check-in: 9940aff1c0 user: mrwellan tags: trunk, v1.24
2011-09-07
23:52
Partial implemenation of writing out ods file from megatest.db check-in: 214b154bb2 user: mrwellan tags: trunk
Changes

Modified db.scm from [f6c0a6448e] to [4147bb9d6c].

610
611
612
613
614
615
616
617
618
619
620
621






























622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652

653
654
655
656
657
658
659
660
661


662
663
664
665
;;======================================================================
;; 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)
  (let ((keysstr  (string-intersperse (map car keypatt-alist) ","))
	(keyqry   (string-intersperse (map (lambda (p)(conc (car p) " like ? ")) keypatt-alist) " AND "))
	(results   '())
	(test-ids '())
	(tempdir  (conc "/tmp/" (current-user-name) "/" runspatt "_" (random 10000) "_" (current-process-id))))






























    (apply sqlite3:for-each-row
     (lambda (test-id . b)
       (set! test-ids (cons test-id test-ids))
       (set! results (append results (list b)))) ;; note, drop the test-id
     db
     (conc "SELECT
              t.id,runname," keysstr ",t.testname,description,
              item_path,t.state,t.status,
              attemptnum,final_logf,logdat,run_duration,r.comment,
              t.event_time,expected_value,value,tol,tol_perc,
              first_err,first_warn,tm.tags,
              r.owner,t.comment,
              author,tm.owner,reviewed,iterated,avg_runtime,
              diskfree,uname,rundir,avg_disk,t.tags,run_id,
              host,cpuload
            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id INNER JOIN test_meta AS tm ON tm.testname=t.testname
            WHERE runname LIKE ? AND " keyqry ";")
     runspatt (map cadr keypatt-alist))
    (set! results (list "Runs" results))
    ;; now, for each test, collect the test_data info and add a new sheet
    (for-each
     (lambda (test-id)
       (let ((test-data '())
	     (curr-test-name #f))
	 (sqlite3:for-each-row
	  (lambda (testname item_path category variable value comment)
	    (set! curr-test-name testname)
	    (set! test-data (append test-data (list (list testname item_path category variable value comment)))))
	  db 
	  "SELECT testname,item_path,category,variable,value,comment FROM test_data INNER JOIN tests ON tests.id=test_data.test_id WHERE test_id=?;"
	  test-id)

	 (set! results (append results (list (cons curr-test-name test-data))))
	 ))
     test-ids)
    (system (conc "mkdir -p " tempdir))
    (pp results)
    (ods:list->ods 
     tempdir
     (if (string-match (regexp "^/") outputfile) ;; full path?
	 outputfile


	 (conc (current-directory) "/" outputfile))
     results)))

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







|
|
<
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








|
|
|
|
|
|
|



|










|

>
|



|


|

>
>
|



610
611
612
613
614
615
616
617
618

619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
;;======================================================================
;; 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)
  (let* ((keysstr  (string-intersperse (map car keypatt-alist) ","))
	 (keyqry   (string-intersperse (map (lambda (p)(conc (car p) " like ? ")) keypatt-alist) " AND "))

	 (test-ids '())
	 (tempdir  (conc "/tmp/" (current-user-name) "/" runspatt "_" (random 10000) "_" (current-process-id)))
	 (runsheader (append (list "Runname")
			     (map car keypatt-alist)
			     (list "Testname" 
				   "Description"
				   "Item Path"
				   "State"
				   "Status"
				   "Final Log"
				   "Run Duration"
				   "When Run"
				   "Expected Value"
				   "Value Found"
				   "Tolerance"
				   "Error"
				   "Warn"
				   "Tags"
				   "Run Owner"
				   "Comment"
				   "Author"
				   "Test Owner"
				   "Reviewed"
				   "Iterated"
				   "Diskfree"
				   "Uname"
				   "Rundir"
				   "Host"
				   "Cpu Load"
				   "Run Id")))
	 (results (list runsheader)))
    (debug:print 2 "Using " tempdir " for constructing the ods file")
    (apply sqlite3:for-each-row
     (lambda (test-id . b)
       (set! test-ids (cons test-id test-ids))
       (set! results (append results (list b)))) ;; note, drop the test-id
     db
     (conc "SELECT
              t.id,runname," keysstr ",t.testname,description,
              item_path,t.state,t.status,
              final_logf,run_duration, 
              strftime('%m/%d/%Y %H:%M:%S',datetime(t.event_time,'unixepoch'),'localtime'),expected_value,value,tol,
              first_err,first_warn,tm.tags,r.owner,t.comment,
              author,
              tm.owner,reviewed,iterated,
              diskfree,uname,rundir,
              host,cpuload,run_id
            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id INNER JOIN test_meta AS tm ON tm.testname=t.testname
            WHERE runname LIKE ? AND " keyqry ";")
     runspatt (map cadr keypatt-alist))
    (set! results (list (cons "Runs" results)))
    ;; now, for each test, collect the test_data info and add a new sheet
    (for-each
     (lambda (test-id)
       (let ((test-data '())
	     (curr-test-name #f))
	 (sqlite3:for-each-row
	  (lambda (testname item_path category variable value comment)
	    (set! curr-test-name testname)
	    (set! test-data (append test-data (list (list testname item_path category variable value comment)))))
	  db 
	  "SELECT testname,item_path,category,variable,test_data.value AS value,test_data.comment AS comment FROM test_data INNER JOIN tests ON tests.id=test_data.test_id WHERE test_id=?;"
	  test-id)
	 (if curr-test-name
	     (set! results (append results (list (cons curr-test-name test-data)))))
	 ))
     test-ids)
    (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" "%")) "%")

Modified keys.scm from [25e7738e04] to [e97ed0b788].

83
84
85
86
87
88
89

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
			   ;; (debug:print 0 "x: " x " val: " val)
			   (if (not val)
			       ;; (debug:print 0 "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")
			       (set! val "default"))
			   (if withkey (list x val) (list val))))
		       argkeys))))
  

;; (define (keys->alist keys)
;;   (let* ((keynames   (map key:get-fieldname keys))
;; 	 (argkeys    (map (lambda (k)(conc ":" k)) keynames))
;; 	 (withkey    (not (null? withkey)))
;; 	 (newremargs (args:get-args (cons "blah" remargs) argkeys '() args:arg-hash 0))) ;; the cons blah works around a bug in args
;;     (debug:print 0 "remargs: " remargs " newremargs: " newremargs)
;;     (apply append (map (lambda (x)
;; 			 (let ((val (args:get-arg x)))
;; 			   (if (not val)
;; 			       (debug:print 0 "ERROR: Ignoring key " x " found in database but not on command line"))
;; 			   (if withkey (list x val) (list val))))
;; 		       argkeys))))

(define (keystring->keys keystring)
  (map (lambda (x)
	 (let ((xlst (string-split x ":")))
	   (list->vector (if (> (length xlst) 1) xlst (append (car xlst)(list "TEXT"))))))
       (delete-duplicates (string-split keystring ","))))

(define (config-get-fields confdat)
  (let ((fields (hash-table-ref/default confdat "fields" '())))
    (map (lambda (x)(vector (car x)(cadr x)))
	 fields)))








>
|
|
<
<
|
<
|
|
|
<
<
|












83
84
85
86
87
88
89
90
91
92


93

94
95
96


97
98
99
100
101
102
103
104
105
106
107
108
109
			   ;; (debug:print 0 "x: " x " val: " val)
			   (if (not val)
			       ;; (debug:print 0 "WARNING: missing key " x ". Specified in database but not on command line, using \"unk\"")
			       (set! val "default"))
			   (if withkey (list x val) (list val))))
		       argkeys))))
  
;; Given a list of keys (list of vectors) return an alist ((key argval) ...)
(define (keys->alist keys defaultval)
  (let* ((keynames   (map key:get-fieldname keys))


	 (newremargs (args:get-args (cons "blah" remargs) (map (lambda (k)(conc ":" k)) keynames) '() args:arg-hash 0))) ;; the cons blah works around a bug in args

    (map (lambda (key)
	   (let ((val (args:get-arg (conc ":" key))))
	     (list key (if val val defaultval))))


	 keynames)))

(define (keystring->keys keystring)
  (map (lambda (x)
	 (let ((xlst (string-split x ":")))
	   (list->vector (if (> (length xlst) 1) xlst (append (car xlst)(list "TEXT"))))))
       (delete-duplicates (string-split keystring ","))))

(define (config-get-fields confdat)
  (let ((fields (hash-table-ref/default confdat "fields" '())))
    (map (lambda (x)(vector (car x)(cadr x)))
	 fields)))

Modified megatest-version.scm from [0e4590aa3f] to [b05fa1ddeb].

1
2
3
;; Always use two digit decimal
;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00..
(define megatest-version 1.23)


|
1
2
3
;; Always use two digit decimal
;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00..
(define megatest-version 1.24)

Modified megatest.scm from [410ce3edb9] to [4c09e8865f].

70
71
72
73
74
75
76

77
78
79
80
81
82
83
  -rerun FAIL,WARN...     : re-run if called on a test that previously ran (nullified
                            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


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
                            If using make use stepname_logpro.log as your target







>







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
  -rerun FAIL,WARN...     : re-run if called on a test that previously ran (nullified
                            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

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
                            If using make use stepname_logpro.log as your target
115
116
117
118
119
120
121

122
123
124
125
126
127
128
			":first_err"
			":first_warn"
			":value"
			":expected_value"
			":tol"
			":units"
			;; misc

			"-debug" ;; for *verbosity* > 2
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"







>







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
			":first_err"
			":first_warn"
			":value"
			":expected_value"
			":tol"
			":units"
			;; misc
			"-extract-ods"
			"-debug" ;; for *verbosity* > 2
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
310
311
312
313
314
315
316














317
318
319
320
321
322
323
    (general-run-call 
     "-rollup" 
     "rollup tests" 
     (lambda (db keys keynames keyvallst)
       (let ((n (args:get-arg "-rollup")))
	 (runs:rollup-run db keys)))))















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

;; 1. find the config file
;; 2. change to the test directory
;; 3. update the db with "test started" status, set running host







>
>
>
>
>
>
>
>
>
>
>
>
>
>







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
    (general-run-call 
     "-rollup" 
     "rollup tests" 
     (lambda (db keys keynames keyvallst)
       (let ((n (args:get-arg "-rollup")))
	 (runs:rollup-run db keys)))))

;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================

(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"))
	     (keyvalalist (keys->alist keys "%")))
	 (db:extract-ods-file db outputfile keyvalalist (if runspatt runspatt "%"))))))

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

;; 1. find the config file
;; 2. change to the test directory
;; 3. update the db with "test started" status, set running host

Modified ods.scm from [1a2ebfec3c] to [6e104f5f8a].

130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157




158


159
160
161
162
163
164
165
166

;; sheetdat is '("sheetname" (r1c1 r2c2 ...)(r2c1 r2c2 ...) ...)
(define (ods:sheet sheetdat)
  (let ((name (car sheetdat))
	(rows (cdr sheetdat)))
    (conc "<table:table table:name=\"" name "\" table:style-name=\"ta1\" table:print=\"false\">\n"
	  (conc (ods:column)
		(apply conc (map ods:row rows)))
	  "</table:table>")))

;; seems to be called once at top of each sheet, i.e. a column of rows
(define (ods:column)
  "<table:table-column table:style-name=\"co1\" table:number-columns-repeated=\"2\" table:default-cell-style-name=\"Default\"/>\n")

;; cells is a list of <table:table-cell ..> ... </table:table-cell>
(define (ods:row cells)
  (apply conc
	 (cons "<table:table-row table:style-name=\"ro1\">\n"
	       (append (map ods:cell cells)
		       (list "</table:table-row>\n")))))

;; types are "string" or "float"
(define (ods:cell value)
  (let ((type (cond
	       ((string? value) "string")
	       ((symbol? value) "string")
	       ((number? value) "float")
	       (else "string"))))




    (conc "<table:table-cell office:value-type=\"" type "\">" "\n"


	  "<text:p>" value "</text:p>" "\n"
	  "</table:table-cell>" "\n")))

;; create the directories
(define (ods:construct-dir path)
  (for-each 
   (lambda (subdir)
     (system (conc "mkdir -p "  path "/" subdir)))







|








<
|
|
|



|



|
>
>
>
>
|
>
>
|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171

;; sheetdat is '("sheetname" (r1c1 r2c2 ...)(r2c1 r2c2 ...) ...)
(define (ods:sheet sheetdat)
  (let ((name (car sheetdat))
	(rows (cdr sheetdat)))
    (conc "<table:table table:name=\"" name "\" table:style-name=\"ta1\" table:print=\"false\">\n"
	  (conc (ods:column)
		(string-join (map ods:row rows) ""))
	  "</table:table>")))

;; seems to be called once at top of each sheet, i.e. a column of rows
(define (ods:column)
  "<table:table-column table:style-name=\"co1\" table:number-columns-repeated=\"2\" table:default-cell-style-name=\"Default\"/>\n")

;; cells is a list of <table:table-cell ..> ... </table:table-cell>
(define (ods:row cells)

  (conc	 "<table:table-row table:style-name=\"ro1\">\n"
	 (string-join (map ods:cell cells) "")
	 "</table:table-row>\n"))

;; types are "string" or "float"
(define (ods:cell value)
  (let* ((type (cond
	       ((string? value) "string")
	       ((symbol? value) "string")
	       ((number? value) "float")
	       (else #f)))
	(tmpval (if (symbol? value)
		    (symbol->string value) 
		    (if type value ""))) ;; convert everything else to an empty string
	(escval (if (string? tmpval)(string-substitute (regexp "<") "&lt;" (string-substitute (regexp ">") "&gt;" tmpval)) tmpval)))
    (conc "<table:table-cell office:value-type=\"" (if type type "string") "\""
	  (if (equal? type "float")(conc " office:value=\"" value "\"") "")
	  ">\n"
	  "<text:p>" escval "</text:p>" "\n"
	  "</table:table-cell>" "\n")))

;; create the directories
(define (ods:construct-dir path)
  (for-each 
   (lambda (subdir)
     (system (conc "mkdir -p "  path "/" subdir)))
201
202
203
204
205
206
207
208
209
	    (ods:add-non-content-files path)
	    (ods:make-thumbnail path)
	    (map display ods:content-header)
	    ;; process each sheet
	    (map print 
		 (map ods:sheet data))
	    (map display ods:content-footer)))
	(system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype`")))))








|

206
207
208
209
210
211
212
213
214
	    (ods:add-non-content-files path)
	    (ods:make-thumbnail path)
	    (map display ods:content-header)
	    ;; process each sheet
	    (map print 
		 (map ods:sheet data))
	    (map display ods:content-footer)))
	(system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype` > /dev/null")))))