Megatest

Check-in [d764a365bb]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Very primitive example cgi page working
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: d764a365bb66a28ae427d3f78795ad0a739804ee
User & Date: matt on 2017-02-26 21:47:33
Other Links: branch diff | manifest | tags
Context
2017-02-26
22:07
Added more illustration for cgi check-in: a624813a5a user: matt tags: v1.64
21:47
Very primitive example cgi page working check-in: d764a365bb user: matt tags: v1.64
21:22
Added beginings for cgi interface support check-in: f9ed9f102e user: matt tags: v1.64
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified cgisetup/pages/index.scm from [ac18dafbf9] to [e1ba568e5b]. 

1
2



3
4
5
6
7
8
9

;; (require-library chicken)
;; (import chicken)




;; (include "src/common_records.scm")
(include "pages/index_ctrl.scm")
(define (pages:index session db shared)
  ;; (s:log " HTTP_COOKIE=" (get-environment-variable "HTTP_COOKIE"))
  (include "pages/index_view.scm")
  ;; (s:html (s:head "head")(s:body "Got here" (current-directory)))



>
>
>








1
2
3
4
5
6
7
8
9
10
11
12

;; (require-library chicken)
;; (import chicken)

(include "../../pgdb.scm")
(declare (uses pgdb))

;; (include "src/common_records.scm")
(include "pages/index_ctrl.scm")
(define (pages:index session db shared)
  ;; (s:log " HTTP_COOKIE=" (get-environment-variable "HTTP_COOKIE"))
  (include "pages/index_view.scm")
  ;; (s:html (s:head "head")(s:body "Got here" (current-directory)))
︙︙

Modified cgisetup/pages/index_view.scm from [5c5837089c] to [9c272c0b09]. 

1
2
3
4

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


18
19
20
21

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


 (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"
	   "stuff goes here")) 


	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

;; 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 "%"))
		   index:jquery
		   index:javascript
		   ))))))

Modified pgdb.scm from [a72ae6f4b9] to [297e203ead].

︙︙
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68


(defstruct area id area-name area-path last-update)

(define (pgdb:add-area dbh area-name area-path)
  (dbi:exec dbh "INSERT INTO areas (area_name,area_path) VALUES (?,?)" area-name area-path))

(define (pgdb:get-areas dbh)
  (map
   (lambda (row)
     (print "row: " row))
   (dbi:get-rows dbh "SELECT id,area_name,area_path,last_sync FROM areas;")))

;; given an area_path get the area info
;;
(define (pgdb:get-area-by-path dbh area-path)
  (dbi:get-one-row dbh "SELECT id,area_name,area_path,last_sync FROM areas WHERE area_path=?;" area-path))

(define (pgdb:write-sync-time dbh area-info new-sync-time)








|
|
|
|








51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68


(defstruct area id area-name area-path last-update)

(define (pgdb:add-area dbh area-name area-path)
  (dbi:exec dbh "INSERT INTO areas (area_name,area_path) VALUES (?,?)" area-name area-path))

(define (pgdb:get-areas dbh)
  ;; (map
  ;;  (lambda (row)
  ;;    (print "row: " row))
  (dbi:get-rows dbh "SELECT id,area_name,area_path,last_sync FROM areas;")) ;; )

;; given an area_path get the area info
;;
(define (pgdb:get-area-by-path dbh area-path)
  (dbi:get-one-row dbh "SELECT id,area_name,area_path,last_sync FROM areas WHERE area_path=?;" area-path))

(define (pgdb:write-sync-time dbh area-info new-sync-time)
︙︙
156
157
158
159
160
161
162









   dbh
   "UPDATE tests SET
      run_id=?,test_name=?,item_path=?,state=?,status=?,host=?,cpuload=?,diskfree=?,uname=?,rundir=?,final_logf=?,run_duration=?,comment=?,event_time=?,archived=?
    WHERE id=?;"

   run-id  test-name item-path    state   status     host  cpuload diskfree uname
   run-dir log-file  run-duration comment event-time archived test-id))
















>
>
>
>
>
>
>
>

156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

   dbh
   "UPDATE tests SET
      run_id=?,test_name=?,item_path=?,state=?,status=?,host=?,cpuload=?,diskfree=?,uname=?,rundir=?,final_logf=?,run_duration=?,comment=?,event_time=?,archived=?
    WHERE id=?;"

   run-id  test-name item-path    state   status     host  cpuload diskfree uname
   run-dir log-file  run-duration comment event-time archived test-id))

(define (pgdb:get-tests dbh target-patt)
  (dbi:get-rows
   dbh
   "SELECT t.id,t.run_id,t.test_name,t.item_path,t.state,t.status,t.host,t.cpuload,t.diskfree,t.uname,t.rundir,t.final_logf,t.run_duration,t.comment,t.event_time,t.archived,
           r.id,r.target,r.ttype_id,r.run_name,r.state,r.status,r.owner,r.event_time,r.comment
     FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
      WHERE r.target LIKE ?;" target-patt))

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