Documentation Source Text

Check-in [67d3af93de]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Initial code for a testing dashboard application. Not yet functional.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | test-dashboard
Files: files | file ages | folders
SHA3-256: 67d3af93de0c264f0f6255b7894a23d403ceb6a5ec6ea00138ef92cad873a46f
User & Date: drh 2019-08-01 20:50:50.976
Context
2019-08-02
15:52
Add an initial version of the client-side uplink library. (check-in: 4e0da90810 user: drh tags: test-dashboard)
2019-08-01
20:50
Initial code for a testing dashboard application. Not yet functional. (check-in: 67d3af93de user: drh tags: test-dashboard)
16:46
Update the /env method of the checklist application to work better with the latest version of Wapp for CGI. (check-in: b1400ebb42 user: drh tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Added misc/dashboard.tcl.




































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
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
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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
#!/home/drh/bin/wapptclsh
#
package require wapp
if {![info exists env(FOSSIL_URI)]} {
  error "This script must be run as a Fossil CGI extension"
}
proc open-database {} {
  set self [wapp-param SCRIPT_FILENAME]
  set dir [file dir $self]
  set dbname [file dir $self]/-[file rootname [file tail $self]].db
  sqlite3 db $dbname
  db eval {
    CREATE TABLE IF NOT EXISTS outcome(
      testId TEXT PRIMARY KEY, -- large random hex key
      platformId TEXT,         -- references platform
      testName TEXT,           -- ex: th3.t05, releasetest.default
      status TEXT,             -- "pass", "fail", "running"
      mtime INT,               -- When this record received, seconds since 1970
      ipaddr TEXT,             -- received from this IP address
      elapsetm INT,            -- Time test took to run, seconds
      srchash TEXT,            -- SQLite source_id()
      srcdate TEXT,            -- SQLite version date, ISO8601
      toolhash TEXT,           -- Test script source_id()
      tooldate TEXT,           -- Test script version date, ISO8610
      expiretm INT,            -- When this record expires, seconds since 1970
      branch TEXT,             -- Branch name for SQLite code
      report TEXT,             -- Final test result text (maybe NULL)
      testcase BLOB            -- Testcase (probably NULL except failures)
    );
    CREATE TABLE IF NOT EXISTS platform(
      platformId TEXT PRIMARY KEY, -- large random hex key
      mtime INT,                   -- time of last change, sec since 1970
      ipaddr TEXT,                 -- IP address of last change
      name TEXT UNIQUE,            -- Short name
      ostype TEXT,                 -- 'linux','windows','mac','sparc'
      os TEXT,                     -- ex: 'Ubuntu 18.04', 'Windows 10'
      owner TEXT,                  -- ex: 'drh'
      location TEXT,               -- ex: 'Charlotte, NC'
      description TEXT             -- ex: 'Yoga laptop'
    );
  }
}
proc common-header {{title {Test Dashboard}} {exlist {}} {newlist {}}} {
  wapp-trim {
     <div class='fossil-doc' data-title='%html($title)'>
     <div class='submenu'>
  }
  set base [wapp-param BASE_URL]
  set sub(Outcomes) olist
  set sub(Platforms) plist
  foreach {name link} $newlist {set sub($name) $link}
  foreach name [lsort [array names sub]] {
    set link $sub($name)
    if {$link ni $exlist} {
      wapp-trim {
        <a class='label' href='%unsafe($base/$link)'>%html($name)</a>
      }
    }
  }
  wapp-subst {</div>\n}
}
proc common-footer {} {
  wapp-subst {</div>\n}
}
proc wapp-page-env {} {
  wapp-allow-xorigin-params
  common-header {Wapp Environment}
  foreach key [array names ::env FOSSIL_*] {
    wapp-set-param $key $::env($key)
  }
  wapp-trim {<pre>%html([wapp-debug-env])</pre>}
  common-footer
}

# Show a list of test outcomes
#
proc wapp-page-olist {} {
  open-database
  set cnt [db one {SELECT count(*) FROM outcome}]
  common-header "Test Outcomes" olist
  wapp-trim {
    <p>Number of tests: %html($cnt)</p>
  }
  common-footer
}

# Make sure the Fossil user has the listed capability.
# Return 0 on success.  If the capability is missing,
# redirect to the login page and return 1.
#
proc check-capability {cap} {
  if {[string match *${cap}* $::env(FOSSIL_CAPABILITIES)]} {
    return 0
  }
  wapp-redirect $::env(FOSSIL_URI)/login?g=[wapp-param REQUEST_URI]
  return 1
}

# List all available platforms
#
proc wapp-page-plist {} {
  if {[check-capability i]} return
  common-header "Test Platforms" plist {{New Platform} padd}
  wapp-trim {
    <table class='sortable' border='1' cellspacing='0' cellpadding='2'\
     data-column-types='ttttx' data-init-sort='1'>
    <thead><tr>
      <th>Name
      <th>OS-Type
      <th>Owner
      <th>Description
      <th>&nbsp;
    </tr></thead>
    <tbody>
  }
  set base [wapp-param BASE_URL]
  open-database
  db eval {SELECT name, ostype, owner, description, rowid
             FROM platform ORDER BY 1} {
    wapp-trim {
      <tr>
      <td>%html($name)
      <td>%html($ostype)
      <td>%html($owner)
      <td>%html($description)
      <td><a href="%html($base)/pdetail/%html($rowid)">Details</a>
      </tr>
    }
  }
  wapp-trim {
    </tbody>
    </table>
    <script src='%url([wapp-param FOSSIL_URI])/builtin/sorttable.js'></script>
  }
  common-footer
}

# Show the details of a single platform entry
#
proc wapp-page-pdetail {} {
  if {[check-capability i]} return
  set id 0
  scan [wapp-param PATH_TAIL] %d id
  open-database
  set seen 0
  db eval {SELECT *, datetime(mtime,'unixepoch') AS ctime
           FROM platform WHERE rowid=$id} {set seen 1; break}
  if {!$seen} {
    common-header "Platform Not Found"
    wapp-subst {<h1>No such platform: %html($id)</h1>\n}
    common-footer
    return
  }
  common-header "Details For Platform $name"
  wapp-trim {
    <table class="label-value">
    <tr><th>Name:</td><td>%html($name)</td>
    <tr><th>OS-Type:</td><td>%html($ostype)</td>
    <tr><th>OS:</td><td>%html($os)</td>
    <tr><th>Location:</td><td>%html($location)</td>
    <tr><th>Description:</td><td>%html($description)</td>
    <tr><th>Owner:</td><td>%html($owner)</td>
    <tr><th>Date:</td><td>%html($ctime)</td>
    <tr><th>Key:</td><td>%html($platformId)</td>
    <table>
  }
  common-footer
}

# Add a new platform entry
#
proc wapp-page-padd {} {
  if {[check-capability i]} return
  open-database
  set nm [wapp-param nm]
  set ostype [wapp-param ostype linux]
  set os [wapp-param os]
  set ds [wapp-param ds]
  set loc [wapp-param loc]
  common-header "Define A New Platform"
  if {$nm!=""} {
    db eval BEGIN
    if {[db exists {SELECT 1 FROM platform WHERE name=$nm}]} {
      wapp-trim {
        <p class='generalError'>
        The platform name "%html($nm)" is already used.  Choose another.
        </p>
      }
    } else {
      set ipaddr [wapp-param REMOTE_ADDR]
      set owner [wapp-param FOSSIL_USER]
      db eval {
        INSERT INTO platform(platformId,mtime,ipaddr,name,ostype,
                             os,owner,location,description)
        VALUES(lower(hex(randomblob(20))),strftime('%s','now'),
               $ipaddr,$nm,$ostype,$os,$owner,$loc,$ds)
      }
      set redir [wapp-param BASE_URL]/pdetail/[db last_insert_rowid]
      db eval COMMIT
      db close
      wapp-redirect $redir
      return
    }
    db eval COMMIT
    db close
  }
  wapp-trim {
    <form method="POST">
    <table class="label-value">
    <tr><th>Name:</th>
    <td><input type='text' size='15' name='nm' value='%html($nm)'></td></tr>
    <tr><th>Class:</th>
    <td><select name='ostype' size='1'>
  }
  foreach x {linux mac windows other} {
    wapp-subst {<option value='%html($x)'}
    if {$x==$ostype} {
      wapp-subst { selected='selected'}
    }
    wapp-subst {>%html($x)</option>\n}
  }
  wapp-trim {
    <tr><th>OS:</th>
    <td><input type='text size='20' name='os' value='%html($os)'></td></tr>
    <tr><th>Location:</th>
    <td><input type='text size='40' name='loc' value='%html($loc)'></td></tr>
    <tr><th>Description:</th>
    <td><input type='text size='40' name='ds' value='%html($ds)'></td></tr>
    <tr><th></th><td><input type='submit' value='Create'></td></tr>
    </table>
    </form>
  }
  common-footer
}

# A POST message has been received that defines a new platform.
# Try to insert it

proc wapp-default {} {
  wapp-page-olist
}
wapp-start {}