Documentation Source Text

  set cnt [db one {SELECT count(*) FROM outcome}]
  common-header "Test Outcomes" olist
  wapp-subst {<ul>\n}
  set last_srchash {}
  set inner_close {}
  db eval {SELECT status, testName, platform.name AS pname, srchash, srcdate,
                  datetime(srcdate) AS sdate,
                  datetime(outcome.mtime,'unixepoch') AS odate
             FROM outcome, platform
            WHERE outcome.mtime>CAST(strftime('%s','now','-1 month') AS INT)
              AND platform.platformId=outcome.platformId

            ORDER BY srcdate DESC, outcome.mtime DESC} {
     if {$srchash!=$last_srchash} {
       wapp-trim {
         %unsafe($inner_close)
         <li><a href='https://sqlite.org/src/timeline?c=%html($srchash)'>
         %html%($sdate)% %html%([string range $srchash 0 16])%</a>
         <ol>
       }
................................................................................
    <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
}



# Report an upload failure
#
proc upload-failure {code reason} {




  wapp-reply-code $code
  wapp-mimetype text/plain
  wapp-subst {%unsafe($reason)}
}

# Receive an outcome upload
#
proc wapp-page-upload {} {
  if {1} {

    puts stderr "****************** upload ************************"
    foreach key [lsort [wapp-param-list]] {
      if {[string index $key 0]=="."} continue
      if {$key=="CONTENT" 
          && [string match text/* [wapp-param CONTENT_TYPE]]==0} continue
      puts stderr "$key = [list [wapp-param $key]]"
    }
  }






  if {[wapp-param CONTENT_TYPE]!="application/x-sqlite"} {
    upload-failure 400 {wrong content type}
    return
  }
  sqlite3 memdb :memory:
  memdb deserialize [wapp-param CONTENT]
  if {[memdb one {PRAGMA quick_check}]!="ok"} {

  set cnt [db one {SELECT count(*) FROM outcome}]
  common-header "Test Outcomes" olist
  wapp-subst {<ul>\n}
  set last_srchash {}
  set inner_close {}
  db eval {SELECT status, testName, platform.name AS pname, srchash, srcdate,
                  datetime(srcdate) AS sdate,
                  datetime(max(outcome.mtime),'unixepoch') AS odate
             FROM outcome, platform
            WHERE outcome.mtime>CAST(strftime('%s','now','-1 month') AS INT)
              AND platform.platformId=outcome.platformId
            GROUP BY testName, srchash
            ORDER BY srcdate DESC, outcome.mtime DESC, status DESC} {
     if {$srchash!=$last_srchash} {
       wapp-trim {
         %unsafe($inner_close)
         <li><a href='https://sqlite.org/src/timeline?c=%html($srchash)'>
         %html%($sdate)% %html%([string range $srchash 0 16])%</a>
         <ol>
       }
................................................................................
    <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
}

set UPLOAD_DEBUG 1

# Report an upload failure
#
proc upload-failure {code reason} {
  global UPLOAD_DEBUG
  if {$UPLOAD_DEBUG} {
    puts stderr "***** upload failed: $reason"
  }
  wapp-reply-code $code
  wapp-mimetype text/plain
  wapp-subst {%unsafe($reason)}
}

# Receive an outcome upload
#
proc wapp-page-upload {} {
  global UPLOAD_DEBUG
  if {$UPLOAD_DEBUG} {
    puts stderr "****************** upload ************************"
    foreach key [lsort [wapp-param-list]] {
      if {[string index $key 0]=="."} continue
      if {$key=="CONTENT" 
          && [string match text/* [wapp-param CONTENT_TYPE]]==0} continue
      puts stderr "$key = [list [wapp-param $key]]"
    }
  }
  set rc [catch {wapp-page-upload-unsafe} msg]
  if {$rc && $UPLOAD_DEBUG} {
    puts stderr "ERROR: $msg"
  }
}
proc wapp-page-upload-unsafe {} {
  if {[wapp-param CONTENT_TYPE]!="application/x-sqlite"} {
    upload-failure 400 {wrong content type}
    return
  }
  sqlite3 memdb :memory:
  memdb deserialize [wapp-param CONTENT]
  if {[memdb one {PRAGMA quick_check}]!="ok"} {

# The dashboard-config command can be run multiple times.  Duplicate
# keys silently overwrite.  The following keys are supported:
#
#     srchash       (REQUIRED) The SHA3 hash of the SQLite version under test
#
#     srcdate       (REQUIRED) Dates of the SQLite version under test in the
#                   ISO8601 format:  "YYYY-MM-DD HH:MM:SS"


#
#     toolhash      (optional) SHA3 hash of the system doing the testing
#
#     tooldate      (optional) ISO8601 date corresponding to toolhash
#
#     elapsetm      (optional) Number of seconds for which the test ran
#
................................................................................
#     dashboard-fail $testName
#
# The dashboard-running command can be invoked multiple times.  After
# dashboard-pass or dashboard-fail, however, the scenario is finish and
# cannot be reused without reconfiguring it from scratch.
#
proc dashboard-init {} {
  sqlite3 dashboard-db :memory:
  dashboard-db eval {PRAGMA page_size=512}
  dashboard-db eval {CREATE TABLE up(k,v)}
}
proc dashboard-uuid {} {
  return [dashboard-db eval {SELECT lower(hex(randomblob(20)))}]
}
proc dashboard-config {name args} {
  upvar #0 dashboard-data-$name D
  foreach {key value} $args {
    set D($key) $value
  }
  if {![info exists D(testId)]} {
    set D(testId) [dashboard-uuid]
  }
}
proc dashboard-unconfig {name} {
  upvar #0 dashboard-data-$name D
  unset D
}
proc dashboard-send {name} {
  upvar #0 dashboard-data-$name D
  if {![info exists D]} {
    error "no such testcase: $name"
  }
  set miss {}
  foreach x {./dashconfig ~/.dashconfig} {
    set x [file normalize $x]
    if {[file readable $x]} {
      set fd [open $x rb]
      foreach {url platformId} [read $fd] break
      close $fd
      break
    } else {
      lappend miss $x
    }
  }
  if {![info exists url]} {
    error "cannot find the dashboard upload configuration any of: $miss"
  }
  for {set cnt 1} {[info command dashdb-$cnt]!=""} {incr cnt} {}














































  dashboard-db eval {DELETE FROM up}


  foreach key [array names D] {
    set val $D($key)
    dashboard-db eval {INSERT INTO up VALUES($key,$val)}
  }
  dashboard-db eval {INSERT INTO up VALUES('platformId',$platformId)}
  set uid [dashboard-uuid]
  set fup dashboard-uplink-$uid.db
  set fdown dashboard-downlink-$uid.txt
  dashboard-db eval {VACUUM INTO $fup}

  dashboard-db eval {DELETE FROM up}
  set cmd "exec fossil test-httpmsg $url/upload $fup \
                  --mimetype application/x-sqlite >$fdown"
  set rc [catch $cmd msg]











  file delete $fup
  file delete $fdown
  if {$rc} {
    error "uplink failed with \"$msg\""
  }
}
proc dashboard-running {name} {
  dashboard-config $name status running
  dashboard-send $name
}
proc dashboard-pass {name} {

# The dashboard-config command can be run multiple times.  Duplicate
# keys silently overwrite.  The following keys are supported:
#
#     srchash       (REQUIRED) The SHA3 hash of the SQLite version under test
#
#     srcdate       (REQUIRED) Dates of the SQLite version under test in the
#                   ISO8601 format:  "YYYY-MM-DD HH:MM:SS"
#
#     branch        (REQUIRED) The branch from which srchash is taken
#
#     toolhash      (optional) SHA3 hash of the system doing the testing
#
#     tooldate      (optional) ISO8601 date corresponding to toolhash
#
#     elapsetm      (optional) Number of seconds for which the test ran
#
................................................................................
#     dashboard-fail $testName
#
# The dashboard-running command can be invoked multiple times.  After
# dashboard-pass or dashboard-fail, however, the scenario is finish and
# cannot be reused without reconfiguring it from scratch.
#
proc dashboard-init {} {








  upvar #0 dashboard-global G
















  set miss {}
  foreach x {./dashconfig ~/.dashconfig} {
    set x [file normalize $x]
    if {[file readable $x]} {
      set fd [open $x rb]
      foreach {url platformId} [read $fd] break
      close $fd
      break
    } else {
      lappend miss $x
    }
  }
  if {![info exists url]} {
    return "cannot find the dashboard upload configuration any of: $miss"
  }
  if {[catch {package require sqlite3}]} {
    return "cannot load the sqlite3 package"
  }
  set G(url) $url
  set G(platformId) $platformId
  set G(trace) 0
  package require sqlite3
  sqlite3 dashboard-db :memory:
  dashboard-db eval {PRAGMA page_size=512}
  dashboard-db eval {CREATE TABLE up(k,v)}
  return {}
}
proc dashboard-remote {} {
  upvar #0 dashboard-global G
  if {[info exists G(url)]} {return $G(url)}
  return {}
}
proc dashboard-uuid {} {
  return [dashboard-db eval {SELECT lower(hex(randomblob(20)))}]
}
proc dashboard-config {name args} {
  upvar #0 dashboard-data-$name D dashboard-global G
  if {![info exists G(url)]} return
  foreach {key value} $args {
    set D($key) $value
  }
  if {![info exists D(testId)]} {
    set D(testId) [dashboard-uuid]
  }
}
proc dashboard-unconfig {name} {
  upvar #0 dashboard-data-$name D
  unset -nocomplain D
}
proc dashboard-trace {bool} {
  upvar #0 dashboard-global G
  set G(trace) $bool
}
proc dashboard-send {name} {
  upvar #0 dashboard-data-$name D dashboard-global G
  if {![info exists G(url)]} return
  if {![info exists D]} {
    error "no such testcase: $name"
  }
  if {$G(trace)} {
    puts "DASHBOARD-TRACE: send $name"
  }
  dashboard-db eval {DELETE FROM up}
  set D(platformId) $G(platformId)
  set D(testName) $name
  foreach key [array names D] {
    set val $D($key)
    dashboard-db eval {INSERT INTO up VALUES($key,$val)}
  }

  set uid [dashboard-uuid]
  set fup dashboard-uplink-$uid.db
  set fdown dashboard-downlink-$uid.txt
  dashboard-db eval {VACUUM}
  dashboard-db backup $fup
  dashboard-db eval {DELETE FROM up}
  set cmd "exec fossil test-httpmsg $G(url)/upload $fup \
                  --mimetype application/x-sqlite >$fdown"
  set rc [catch $cmd msg]
  if {$G(trace)} {
    puts "DASHBOARD-TRACE: $cmd"
    if {$rc} {
      puts "DASHBOARD-TRACE: upload failed: $msg"
    }
  }
  if {$rc} {
    puts stderr "dashboard uplink to $G(url) failed"
    puts stderr "error-message: \"$msg\""
    puts stderr "uplink-command: $cmd"
  } else {
    file delete $fup
    file delete $fdown


  }
}
proc dashboard-running {name} {
  dashboard-config $name status running
  dashboard-send $name
}
proc dashboard-pass {name} {