Megatest

Check-in [b44a827342]
Login
Overview
Comment:Added a couple basic widgets to page
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: b44a82734266765c0a857e71cc7570e1fc15ae1d
User & Date: matt on 2017-02-27 23:03:56
Other Links: branch diff | manifest | tags
Context
2017-02-28
23:44
Re-org'd some files and provided a skeleton cgi with some examples check-in: 6c5ce13b65 user: matt tags: v1.64
2017-02-27
23:03
Added a couple basic widgets to page check-in: b44a827342 user: matt tags: v1.64
09:39
Updated megatest version for 1.6402 check-in: 03c5160677 user: jmoon18 tags: v1.64, v1.6402
Changes

Modified cgisetup/pages/index_ctrl.scm from [cf7de092cc] to [8dcafae98b].


1
2







3












4
5
6
7
8
9
10

;; Copyright 2007-2008, Matthew Welland. Kiatoa.com All rights reserved.
;; 







;; this gets read for ALL pages. Don't weigh it down excessively!













(define index:kickstart-junk
#<<EOF
<meta charset="UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1.0"/>
<meta name="description" content="" />

>
|

>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
;;======================================================================
;; Copyright 2017, 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.
;;======================================================================

;; a function <pagename>-action is called on POST

(define (index-action action)
  (case (string->symbol action)
    ((filter)
     (let ((target-type   (s:get-input 'target-type))
	   (target-filter (s:get-input 'tfilter))
	   (target        (s:get-input 'target)))
       (s:session-var-set! "target-type" target-type)
       (s:set! "tfilter" target-filter)
       (s:session-var-set! "target"  target)
       (s:session-var-set! "target-filter" target-filter)))))

(define index:kickstart-junk
#<<EOF
<meta charset="UTF-8">
<meta name="viewport" content="width=device-width, initial-scale=1.0"/>
<meta name="description" content="" />

Modified cgisetup/pages/index_view.scm from [792ee1b6e9] to [e907b56ea5].


1
2








3
4
5





6
7
8
9
10
11
12
13
14
15
16
17


















18
19
20
21
22
23
24
25
26

;; Copyright 2007-2008, Matthew Welland. Megatest All rights reserved.
;; 








;; index

(let ((dbh (s:db)))





  (list
   "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
   (s:html
    (s:title (conc "Megatest ")) 
    (s:head
     index:kickstart-junk
     ) 
    (s:body
     (s:div 'class "grid flex" 'id "top_of_page"
	    ;; add visible to columns to help visualize them e.g. "col_12 visible"
	    ;; BEGINNING OF HEADER
	    (s:div 'class "col_12"


















		   (map (lambda (area)
			  (s:p "data=" (conc area)))
			;; (pgdb:get-tests dbh "%")
			(pgdb:get-stats-given-target dbh "v1.63/%")
			)
		   index:jquery
		   index:javascript
		   ))))))

>
|

>
>
>
>
>
>
>
>


|
>
>
>
>
>



|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
;;======================================================================
;; Copyright 2017, 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.
;;======================================================================

;; index

(let* ((dbh      (s:db))
       (ttypes   (pgdb:get-target-types dbh))
       (selected (string->number (or (s:session-var-get "target-type") "0")))
       (tfilter  (or (s:session-var-get "target-filter") "%"))
       (targets  (pgdb:get-targets-of-type dbh selected tfilter))
       (target   (s:session-var-get "target")))
  (list
   "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">"
   (s:html
    (s:title (conc "Megatest")) 
    (s:head
     index:kickstart-junk
     ) 
    (s:body
     (s:div 'class "grid flex" 'id "top_of_page"
	    ;; add visible to columns to help visualize them e.g. "col_12 visible"
	    ;; BEGINNING OF HEADER
	    (s:div 'class "col_12"
		   (s:form
		    'action "index.filter" 'method "post"
		    (s:select (map (lambda (x)
				     (let ((tt-id (vector-ref x 0))
					   (ttype (vector-ref x 1)))
				       (if (eq? tt-id selected)
					   (list ttype tt-id ttype #t)
					   (list ttype tt-id ttype #f))))
				   ttypes)
			      'name 'target-type)
		    (s:input-preserve 'name "tfilter" 'placeholder "Filter targets")
		    (s:select (map (lambda (x)
				     (let ((t (vector-ref x 0)))
				       (list t t t (equal? t target))))
				   targets)
			      'name  'target)
		    (s:input 'type "submit" 'name "set-filter-vals" 'value "Submit" 'class "col_3")
		    ;; (s:h1 (s:session-var-get "target-type"))
		    (map (lambda (area)
			   (s:p "data=" (conc area)))
			 ;; (pgdb:get-tests dbh (or target "%"))
			 (pgdb:get-stats-given-target dbh (or target "%"))
			 )
		    index:jquery
		    index:javascript
		    )))))))

Modified pgdb.scm from [c1d8e3c1bf] to [5b1573d761].

170
171
172
173
174
175
176
177




















      WHERE r.target LIKE ?;" target-patt))

(define (pgdb:get-stats-given-target dbh target-patt)
  (dbi:get-rows
   dbh
   "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
        WHERE t.state='COMPLETED' AND r.target LIKE ? GROUP BY t.status,r.target;" target-patt))
  



























|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
      WHERE r.target LIKE ?;" target-patt))

(define (pgdb:get-stats-given-target dbh target-patt)
  (dbi:get-rows
   dbh
   "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
        WHERE t.state='COMPLETED' AND r.target LIKE ? GROUP BY t.status,r.target;" target-patt))

(define (pgdb:get-target-types dbh)
  (dbi:get-rows dbh "SELECT id,target_spec FROM ttype;"))

;; 
(define (pgdb:get-targets dbh target-patt)
  (let ((ttypes (pgdb:get-target-types dbh)))
    (map
     (lambda (ttype-dat)
       (let ((tt-id (vector-ref ttype-dat 0))
	     (ttype (vector-ref ttype-dat 1)))
	 (cons ttype
	       (dbi:get-rows 
		dbh
		"SELECT DISTINCT target FROM runs WHERE target LIKE ? AND ttype_id=?;" target-patt tt-id))
	 ))
     ttypes)))

(define (pgdb:get-targets-of-type dbh ttype-id target-patt)
  (dbi:get-rows dbh "SELECT DISTINCT target FROM runs WHERE target LIKE ? AND ttype_id=?;" target-patt ttype-id))