Megatest

Check-in [9940aff1c0]
Login
☰Home Timeline Files Branches Tags Tickets Wiki 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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

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

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 "))
  (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))))
	 (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,
              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
              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 "Runs" results))
    (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,value,comment FROM test_data INNER JOIN tests ON tests.id=test_data.test_id WHERE test_id=?;"
	  "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))))
	     (set! results (append results (list (cons curr-test-name test-data)))))
	 ))
     test-ids)
    (system (conc "mkdir -p " tempdir))
    (pp results)
    ;; (pp results)
    (ods:list->ods 
     tempdir
     (if (string-match (regexp "^/") outputfile) ;; full path?
     (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))
	   (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

83
84
85
86
87
88
89
90


91
92



93




94
95
96



97
98
99
100
101
102
103
104








+
-
-
+
+
-
-
-
+
-
-
-
-
+
+
+
-
-
-
+








			   ;; (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)
;;   (let* ((keynames   (map key:get-fieldname keys))
(define (keys->alist keys defaultval)
  (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
	 (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
;;     (debug:print 0 "remargs: " remargs " newremargs: " newremargs)
;;     (apply append (map (lambda (x)
;; 			 (let ((val (args:get-arg x)))
;; 			   (if (not val)
    (map (lambda (key)
	   (let ((val (args:get-arg (conc ":" key))))
	     (list key (if val val defaultval))))
;; 			       (debug:print 0 "ERROR: Ignoring key " x " found in database but not on command line"))
;; 			   (if withkey (list x val) (list val))))
;; 		       argkeys))))
	 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 ","))))
︙

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

1
2
3


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)
(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

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

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

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

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)
		(apply conc (map ods:row rows)))
		(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)
  (apply conc
	 (cons "<table:table-row table:style-name=\"ro1\">\n"
	       (append (map ods:cell cells)
		       (list "</table:table-row>\n")))))
  (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
  (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"
	       (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

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`")))))
	(system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype` > /dev/null")))))

This page was generated in about 0.111s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00