Checklist

Artifact Content
Login

Artifact 8f94882fa0e9b3ea1e9659ee510f53720a476f23:


     1  #!/usr/bin/wapptclsh
     2  #
     3  # This script implements a release-checklist web application.  Installation
     4  # steps:
     5  #
     6  #   (1) Put the wapptclsh framework binary in /usr/bin (or equivalent)
     7  #   (2) Create a directory to store checklist databases.  Edit this
     8  #       script to store the database directory in DATADIR
     9  #   (3) Install at least one template database.  Perhaps use one of the
    10  #       testing databases found in the source code repository for this
    11  #       script.  The details of the checklist, logins and passwords, and
    12  #       so forth can be edited after the application is running.
    13  #   (4) Activate the server by one of the following techniques:
    14  #       (4a) Run "wapptclsh checklist.tcl" for a pop-up instance on the
    15  #            local machine.
    16  #       (4b) Run "wapptclsh checklist.tcl --server 8080" for an HTTP server.
    17  #       (4c) Make this script a CGI script according to however CGI works
    18  #            on your web server
    19  #       (4d) Run "wapptclsh checklist.tcl --scgi 9000" to start an SCGI
    20  #            server, then configure Nginx to relay requests to TCP port 9000.
    21  #
    22  set DATADIR /checklist  ;# Edit to be the directory holding checklist databases
    23  
    24  package require wapp
    25  
    26  # Any unknown URL dispatches to this routine.  List all available
    27  # checklists.
    28  #
    29  proc wapp-default {} {
    30    wapp-page-listing
    31  }
    32  
    33  # List all available checklists.
    34  #
    35  proc wapp-page-listing {} {
    36    global DATADIR
    37    wapp-subst {<h1>Available Checklists</h1>\n}
    38    wapp-subst {<ol>\n}
    39    foreach dbfile [lsort -decreasing [glob -nocomplain $DATADIR/*.db]] {
    40      set name [file rootname [file tail $dbfile]]
    41      set url [wapp-param BASE_URL]/$name/index
    42      wapp-subst {<li><a href='%url($url)'>%html($name)</a>\n}
    43    }
    44    wapp-subst {</ol>\n}
    45  }
    46  
    47  # Show the CGI environment for testing purposes.
    48  #
    49  proc wapp-page-env {} {
    50    wapp-subst {<h1>Environment</h1>\n}
    51    wapp-subst {<pre>%html([wapp-debug-env])</pre>\n}
    52  }
    53  
    54  # Check user permissions by looking at the login/password in the
    55  # checklist-login cookie.  Set the following environment variables:
    56  #
    57  #     CKLIST_USER      Name of the user.  Empty string if not logged in
    58  #     CKLIST_WRITE     True if the user is allowed to make updates
    59  #     CKLIST_ADMIN     True if the user is an administrator.
    60  #
    61  # The database should already be open.
    62  #
    63  proc checklist-verify-login {} {
    64    set x [wapp-param checklist-login]
    65    set user {}
    66    set write 0
    67    set admin 0
    68    set u {}
    69    set p {}
    70    foreach {u p} [split $x ,] {
    71      if {[db exists {SELECT 1 FROM config
    72                       WHERE name=('user-'||$u)
    73                         AND hex(value)=$p}]} {
    74        set write 1
    75        set user $u
    76        if {[db exists {SELECT 1 FROM config WHERE name=('admin-'||$u)}]} {
    77          set admin 1
    78        }
    79      }
    80      break;
    81    }
    82    wapp-set-param CKLIST_ADMIN $admin
    83    wapp-set-param CKLIST_WRITE $write
    84    wapp-set-param CKLIST_USER $user
    85  }
    86  
    87  # Print the common header shown on all pages
    88  #
    89  # Return 1 to abort.  Return 0 to continue with page generation.
    90  #
    91  proc checklist-common-header {} {
    92    if {![wapp-param-exists OBJECT] || [set dbfile [wapp-param OBJECT]]==""} {
    93      wapp-redirect listing
    94      return 1
    95    }
    96    sqlite3 db $dbfile -create 0
    97    db timeout 1000
    98    db eval BEGIN
    99    set title [db one {SELECT value FROM config WHERE name='title'}]
   100    wapp-trim {
   101      <html>
   102      <head>
   103      <link rel="stylesheet" href="style.css" type="text/css" media="screen">
   104      </head>
   105      <body>
   106      <h1>%html($title)</h1>
   107    }
   108    checklist-verify-login
   109    wapp-subst {<div class="mainmenu">\n}
   110    set this [wapp-param PATH_HEAD]
   111    if {$this!="index"} {
   112      wapp-subst {<a href='index'>checklist</a>\n}
   113    }
   114    set write [wapp-param CKLIST_WRITE 0]
   115    if {$write==0 && $this!="login"} {
   116      wapp-subst {<a href='login'>login</a>\n}
   117    }
   118    if {$write==1 && $this!="logout"} {
   119      wapp-subst {<a href='logout'>%html([wapp-param CKLIST_USER])-logout</a>\n}
   120    }
   121    set admin [wapp-param CKLIST_ADMIN 0]
   122    if {$admin} {
   123      if {$this!="sql"} {
   124        wapp-subst {<a href='sql'>sql</a>\n}
   125      }
   126      if {$this!="cklistedit"} {
   127        wapp-subst {<a href='cklistedit'>edit-checklist</a>\n}
   128      }
   129    }
   130    wapp-subst {<a href='../listing'>catalog</a>\n}
   131    wapp-subst {</div>\n}
   132    return 0
   133  }
   134  
   135  # Close out a web page.  Close the database connection that was opened
   136  # by checklist-common-header.
   137  #
   138  proc checklist-common-footer {} {
   139    wapp-subst {</body></html>}
   140    catch {db close}
   141  }
   142  
   143  # Draw the login screen
   144  #
   145  proc wapp-page-login {} {
   146    if {[checklist-common-header]} return
   147    if {[string match https:* [wapp-param BASE_URL]]==0
   148         && [wapp-param REMOTE_ADDR]!="127.0.0.1"} {
   149      wapp-subst {<p class="error">Login via HTTPS only</p>}
   150      checklist-common-footer
   151      return
   152    }
   153    if {[wapp-param SAME_ORIGIN]
   154     && [wapp-param-exists u]
   155     && [wapp-param-exists p]
   156    } {
   157      set u [wapp-param u]
   158      set p [wapp-param p]
   159      set px [db one {SELECT hex($p)}]
   160      set ok [db exists {SELECT 1 FROM config
   161                          WHERE name=('user-'||$u)
   162                            AND hex(value)=$px}]
   163      if {$ok} {
   164        wapp-set-cookie checklist-login $u,$px
   165        wapp-redirect index
   166        return
   167      }
   168      wapp-subst {<p class='error'>Invalid username or password</p>\n}
   169    }
   170    if {![wapp-param-exists HTTP_REFERER]} {
   171      wapp-trim {
   172         <h2>Warning: No "Referer" header</h2>
   173         <p> As a defense against cross-site request forgeries, this website
   174         ignores all POST requests that omit the "Referer:" from the header.
   175         The request that resulted in this page has no "Referer:" entry 
   176         in the header.
   177         So, unless something changes, you won't be able to log in.</p>
   178      }
   179    }
   180    wapp-trim {
   181      <form method='POST' action='login'>
   182      <table border="0">
   183      <tr><td align='right'>Login:&nbsp;</td>
   184          <td><input type='text' name='u' width='20'></td></tr>
   185      <tr><td align='right'>Password:&nbsp;</td>
   186          <td><input type='password' name='p' width='20'></td></tr>
   187      <tr><td><td><input type='submit' value='Login'></td></tr>
   188      </table></form>
   189    }
   190    checklist-common-footer
   191  }
   192  
   193  # Draw the logout screen
   194  #
   195  proc wapp-page-logout {} {
   196    if {[checklist-common-header]} return
   197    if {![wapp-param CKLIST_WRITE] || [wapp-param-exists logout]} {
   198      wapp-clear-cookie checklist-login
   199      wapp-redirect index
   200      return
   201    }
   202    if {[wapp-param-exists cancel]} {
   203      wapp-redirect index
   204      return
   205    }
   206    set u [wapp-param CKLIST_USER]
   207    wapp-trim {
   208      <form method='POST' action='logout'>
   209      <input type='submit' name='logout' value='%html($u) Logout'>
   210      <input type='submit' name='cancel' value='Cancel'>
   211      </form>
   212    }
   213    checklist-common-footer
   214  }
   215  
   216  # Show the main checklist page
   217  #
   218  proc wapp-page-index {} {
   219    if {[checklist-common-header]} return
   220    set level 0
   221    db eval {SELECT seq, printf('%016llx',itemid) AS itemid, txt
   222             FROM checklist ORDER BY seq} {
   223      if {$seq%100==0} {
   224        set newlevel 1
   225      } else {
   226        set newlevel 2
   227      }
   228      while {$newlevel>$level} {
   229        if {$level==0} {
   230          wapp-subst {<ol id="mainCklist" type='1'>\n}
   231        } else {
   232          wapp-subst {<p><ol type='a'>\n}
   233        }
   234        incr level
   235      }
   236      while {$newlevel<$level} {
   237        wapp-subst {</ol>\n}
   238        incr level -1
   239      }
   240      if {$level==1} {wapp-subst {<p>}}
   241      wapp-trim {
   242        <li class='ckitem' id='item-%unsafe($itemid)'><span>%unsafe($txt)</span>
   243        <span class='ckuid' id='stat-%unsafe($itemid)'></span>
   244        <div class='ckcom' id='com-%unsafe($itemid)'></div></li>\n
   245      }
   246    }
   247    while {$level>0} {
   248      wapp-subst {</ol>\n}
   249      incr level -1
   250    }
   251  
   252    # Render the edit dialog box. CSS sets "display: none;" on this so that
   253    # it does not appear.  Javascript will turn it on and position it on
   254    # the correct element following any click on the checklist.
   255    #
   256    if {![wapp-param WRITE 0]} {
   257      wapp-trim {
   258        <div id="editBox">
   259        <form id="editForm" method="POST">
   260        <table border="0">
   261        <tr>
   262        <td align="right">Status:&nbsp;
   263        <td><select id="editStatus" name="stat" size="1">
   264        <option value="ok">ok</option>
   265        <option value="prelim">prelim</option>
   266        <option value="fail">fail</option>
   267        <option value="review">review</option>
   268        <option value="pending">pending</option>
   269        <option value="retest">retest</option>
   270        <option value="---">---</option>
   271        </select>
   272        <tr>
   273        <td align="right" valign="top">Comments:&nbsp;
   274        <td><textarea id="editCom" name="com" cols="80" rows="2"></textarea>
   275        <tr>
   276        <td>
   277        <td><button id="applyBtn">Apply</button>
   278        <button id="cancelBtn">Cancel</button>
   279        </table>
   280        </form>
   281        </div>
   282      }
   283    }
   284      
   285    # The cklistUser object is JSON that contains information about the
   286    # login user and the capabilities of the login user, which the
   287    # javascript code needs to know in order to activate various features.
   288    #
   289    wapp-subst {<script id='cklistUser' type='application/json'>}
   290    if {![wapp-param CKLIST_WRITE]} {
   291      wapp-subst {{"user":"","canWrite":0,"isAdmin":0}}
   292    } else {
   293      set u [wapp-param CKLIST_USER]
   294      set ia [wapp-param CKLIST_ADMIN]
   295      wapp-subst {{"user":"%string($u)","canWrite":1,"isAdmin":%qp($ia)}}
   296    }
   297    wapp-subst {</script>\n}
   298  
   299    wapp-subst {<script src='cklist.js'></script>\n}
   300    checklist-common-footer
   301  }
   302  
   303  # The CSS for the main checklist page goes here
   304  #
   305  proc wapp-page-style.css {} {
   306    wapp-mimetype text/css
   307    wapp-cache-control max-age=86400
   308    wapp {
   309      h1 { text-align: center; }
   310      div.ckcom {
   311        font-size: 80%;
   312        font-style: italic;
   313        white-space: pre;
   314      }
   315      span.ckuid {
   316        font-size: 80%;
   317        cursor: pointer;
   318      }
   319      div.mainmenu {
   320        text-align: center;
   321        border: 1px solid black;
   322        padding: 2ex;
   323      }
   324      div.mainmenu a {
   325        margin: 0 1.5ex;
   326      }
   327      p.error {
   328        font-weight: bold;
   329        color: red;
   330      }
   331      #editBox {
   332        display: none;
   333        border: 1px solid black;
   334      }
   335    }
   336  }
   337  
   338  # The javascript for the main checklist page goes here
   339  #
   340  proc wapp-page-cklist.js {} {
   341    wapp-mimetype text/javascript
   342    wapp-cache-control max-age=86400
   343    wapp {
   344      function cklistAjax(uri,data,callback){
   345        var xhttp = new XMLHttpRequest();
   346        xhttp.onreadystatechange = function(){
   347          if(xhttp.readyState!=4) return
   348          if(!xhttp.responseText) return
   349          var jx = JSON.parse(xhttp.responseText);
   350          callback(jx);
   351        }
   352        if(data){
   353          xhttp.open("POST",uri,true);
   354          xhttp.setRequestHeader("Content-Type",
   355                                 "application/x-www-form-urlencoded");
   356          xhttp.send(data)
   357        }else{
   358          xhttp.open("GET",uri,true);
   359          xhttp.send();
   360        }
   361      }
   362      function cklistClr(stat){
   363        stat = stat.replace(/\++/g,'');
   364        if(stat=="ok") return '#00a000';
   365        if(stat=="prelim") return '#0080ff';
   366        if(stat=="fail") return '#a00028';
   367        if(stat=="review") return '#007088';
   368        if(stat=="pending") return '#4f0080';
   369        if(stat=="retest") return '#904800';
   370        return '#000000';
   371      }
   372      function cklistApplyJstat(jx){
   373        var i;
   374        var n = jx.length;
   375        for(i=0; i<n; i++){
   376          var x = jx[i];
   377          var name = "item-"+x.itemid
   378          var e = document.getElementById(name);
   379          if(!e) continue
   380          e.style.color = cklistClr(x.status);
   381          e = document.getElementById("stat-"+x.itemid);
   382          if(!e) continue;
   383          var s = "(" + x.status + " " + x.owner
   384          if( x.chngcnt>1 ){
   385            s += " " + x.chngcnt + "x)"
   386          }else{
   387            s += ")"
   388          }
   389          e.innerHTML = s
   390          if( x.comment && x.comment.length>0 ){
   391            e = document.getElementById("com-"+x.itemid);
   392            e.innerHTML = x.comment;
   393          }
   394          if( editItem && editItem.id==name ){
   395            document.getElementById("editStatus").value = x.status;
   396            document.getElementById("editCom").value = x.comment;
   397          }
   398        }
   399      }
   400      cklistAjax('jstat',null,cklistApplyJstat);
   401      var userNode = document.getElementById("cklistUser");
   402      var userInfo = JSON.parse(userNode.textContent||userNode.innerText);
   403      if(userInfo.canWrite){
   404        var allItem = document.getElementsByClassName("ckitem");
   405        for(var i=0; i<allItem.length; i++){
   406          allItem[i].style.cursor = "pointer";
   407        }
   408      }
   409      function historyOff(itemid){ 
   410        var e = document.getElementById("hist-"+itemid);
   411        if(e) e.parentNode.removeChild(e);
   412      }
   413      function historyOn(itemid){
   414        var req = new XMLHttpRequest
   415        req.open("GET","history?itemid="+itemid,true);
   416        req.onreadystatechange = function(){
   417          if(req.readyState!=4) return
   418          var lx = document.getElementById("item-"+itemid);
   419          var tx = document.createElement("DIV");
   420          tx.id = "hist-"+itemid;
   421          tx.style.borderWidth = 1
   422          tx.style.borderColor = "black"
   423          tx.style.borderStyle = "solid"
   424          tx.innerHTML = req.responseText;
   425          lx.appendChild(tx);
   426        }
   427        req.send();
   428      }
   429      var editItem = null
   430      var editBox = document.getElementById("editBox");
   431      document.getElementById("mainCklist").onclick = function(event){
   432        var e = document.elementFromPoint(event.clientX,event.clientY);
   433        while(e && e.tagName!="LI"){
   434          if(e.id){
   435            if(e.id=="editForm") return;
   436            if(e.id.substr(0,5)=="stat-"){
   437              var id = e.id.substr(5);
   438              if( document.getElementById("hist-"+id) ){
   439                historyOff(id)
   440              }else{
   441                historyOn(id)
   442              }
   443              return;
   444            }
   445          }
   446          if(e==editBox) return;
   447          e = e.parentNode;
   448        }
   449        if(!userInfo.canWrite) return
   450        if(!e) return
   451        if(editItem) editItem.removeChild(editBox);
   452        if(e==editItem){
   453          editItem = null;
   454          return;
   455        }
   456        editBox.style.display = "block";
   457        editItem = e;
   458        historyOff(e.id.substr(5))
   459        editItem.appendChild(editBox);
   460        cklistAjax("jstat?itemid="+e.id.substr(5),null,cklistApplyJstat);
   461        document.getElementById("cancelBtn").onclick = function(event){
   462          event.stopPropagation();
   463          editItem.removeChild(editBox);
   464          editItem = null;
   465        }
   466        document.getElementById("applyBtn").onclick = function(event){
   467          var data = "update=" + editItem.id.substr(5);
   468          var e = document.getElementById("editStatus");
   469          data += "&status=" + escape(e.value);
   470          e = document.getElementById("editCom");
   471          data += "&comment=" + escape(e.value);
   472          cklistAjax("jstat",data,cklistApplyJstat);
   473          editItem.removeChild(editBox);
   474          editItem = null;
   475          event.stopPropagation();
   476        }
   477        document.getElementById("editForm").onsubmit = function(){
   478          return false;
   479        }
   480      }
   481    }
   482    # wapp-subst {window.alert("Javascript loaded");\n}
   483  }
   484  
   485  # The /jstat page returns JSON that describes the current
   486  # status of all elements of the checklist.
   487  #
   488  # If the update query parameter exists and is not an empty string,
   489  # and if checklist-login is a valid login for a writer, then revise
   490  # the ckitem entry where itemid=$update using query parameters
   491  # {update->itemid,status,comment} and with owner set to the login user,
   492  # before returning the results.
   493  #
   494  # If the itemid query parameter exists and is not an empty string,
   495  # then return only the status to that one checklist item.  Otherwise,
   496  # return the status of all checklist items.
   497  #
   498  # The update and itemid parameters come in as hex.  They must be
   499  # converted to decimal before being used for queries.
   500  #
   501  proc wapp-page-jstat {} {
   502    if {![wapp-param-exists OBJECT] || [set dbfile [wapp-param OBJECT]]==""} {
   503      wapp-redirect listing
   504      return
   505    }
   506    wapp-mimetype text/json
   507    sqlite3 db $dbfile
   508    db eval BEGIN
   509    set update [wapp-param update]
   510    if {$update!=""} {
   511      checklist-verify-login
   512      if {[wapp-param CKLIST_WRITE 0] && [scan $update %x update]==1} {
   513        set status [wapp-param status]
   514        set comment [wapp-param comment]
   515        set owner [wapp-param CKLIST_USER]
   516        db eval {
   517           REPLACE INTO ckitem(itemid,mtime,status,owner,comment)
   518            VALUES($update,julianday('now'),$status,$owner,$comment);
   519           INSERT INTO history(itemid,mtime,status,owner,comment)
   520            VALUES($update,julianday('now'),$status,$owner,$comment);
   521        }
   522      }
   523    }
   524    set itemid [wapp-param itemid]
   525    if {$itemid!="" && [scan $itemid %x itemid]==1} {
   526      set sql {
   527        SELECT json_group_array(
   528          json_object('itemid', printf('%016llx',itemid),
   529                      'mtime', strftime('%s',mtime)+0,
   530                      'status', rtrim(status,'+'),
   531                      'owner', owner,
   532                      'comment', comment,
   533                      'chngcnt', (SELECT count(*) FROM history
   534                                  WHERE itemid=$itemid)))
   535        FROM ckitem WHERE itemid=$itemid
   536      }
   537    } else {
   538      set sql {
   539        WITH chngcnt(cnt,itemid) AS (
   540           SELECT count(*), itemid FROM history GROUP BY itemid
   541        )
   542        SELECT json_group_array(
   543          json_object('itemid', printf('%016llx',itemid),
   544                      'mtime', strftime('%s',mtime)+0,
   545                      'status', rtrim(status,'+'),
   546                      'owner', owner,
   547                      'comment', comment,
   548                      'chngcnt', COALESCE(chngcnt.cnt,0))
   549          )
   550          FROM ckitem LEFT JOIN chngcnt USING(itemid)
   551      }
   552    }
   553    wapp-unsafe [db one $sql]
   554    db eval COMMIT
   555    db close
   556    # puts "jstat from $dbfile"
   557  }
   558  
   559  # The /history page returns an HTML table that shows the history of
   560  # changes to a single checklist item.
   561  #
   562  #
   563  proc wapp-page-history {} {
   564    set dbfile [wapp-param OBJECT]
   565    set itemid [wapp-param itemid]
   566    if {$dbfile=="" || $itemid=="" || [scan $itemid %x itemid]!=1} return
   567    wapp-mimetype text/text
   568    sqlite3 db $dbfile
   569    db eval BEGIN
   570    wapp-subst {<table border="0" cellspacing="4">\n}
   571    set date {}
   572    db eval {SELECT date(mtime) as dx, strftime('%H:%M',mtime) as tx,
   573                    owner, rtrim(status,'+') AS status, comment FROM history
   574                    WHERE itemid=$itemid
   575                    ORDER BY julianday(mtime) DESC} {
   576       if {$dx!=$date} {
   577         wapp-subst {<tr><td>%html($dx)<td><td>\n}
   578         set date $dx
   579       }
   580       wapp-trim {
   581          <tr><td align="right" valign="top">%html($tx)
   582              <td valign="top">%html($status) %html($owner)
   583              <td>%html($comment)</tr>\n
   584       }
   585    }
   586    wapp-subst {</table>\n}
   587  }
   588  
   589  
   590  # The /sql page for doing arbitrary SQL on the database.
   591  # This page is accessible to the administrator only.
   592  #
   593  proc wapp-page-sql {} {
   594    if {[checklist-common-header]} return
   595    if {![wapp-param CKLIST_ADMIN 0]} {
   596      wapp-redirect index
   597      return
   598    }
   599    set sql [string trimright [wapp-param sql]]
   600    wapp-trim {
   601      <form method="POST" action="sql"><table border="0">
   602      <tr><td valign="top">SQL:&nbsp;
   603      <td><textarea name="sql" rows="5" cols="60">%html($sql)</textarea>
   604      <tr><td><td><input type="submit" value="Run">
   605      </table></form>
   606    }
   607    if {$sql!=""} { 
   608      set i 0
   609      wapp-subst {<hr><table border="1">\n}
   610      set rc [catch {
   611        db eval $sql x {
   612          if {$i==0} {
   613            wapp-subst {<tr>\n}
   614            foreach c $x(*) {
   615              wapp-subst {<th>%html($c)\n}
   616            }
   617            wapp-subst {</tr>\n}
   618            incr i
   619          }
   620          wapp-subst {<tr>\n}
   621          foreach c $x(*) {
   622            set v [set x($c)]
   623            wapp-subst {<td>%html($v)\n}
   624          }
   625          wapp-subst {</tr>}
   626        }
   627      } msg]
   628      if {$rc} {
   629        wapp-subst {<tr><td>ERROR: %html($msg)\n}
   630      }
   631      wapp-subst {</table>}
   632    }
   633    db eval COMMIT
   634    checklist-common-footer 
   635  }
   636  
   637  # Generate a text encoding of the checklist table
   638  #
   639  #    # (hash) top level item
   640  #    ## (hash) second-level item
   641  #    ## (hash) another second-level
   642  #    # (hash) another top-level
   643  #
   644  proc checklist-as-text {} {
   645    set out {}
   646    db eval {SELECT seq, itemid, txt FROM checklist ORDER BY seq} {
   647      set id [format %x $itemid]
   648      regsub -all {\s+} [string trim $txt] { } txt
   649      if {($seq%100)==0} {
   650        append out "# ($id) $txt\n"
   651      } else {
   652        append out "## ($id) $txt\n"
   653      }
   654    }
   655    return $out
   656  }
   657  
   658  # Replace the content of the checklist table with a decoding
   659  # of the text string given in the argument.  Throw an error and
   660  # rollback the change if anything doesn't look right.
   661  #
   662  proc checklist-rebuild-from-text {txt} {
   663    set re {^(\#\#?) (\([0-9a-fA-F]+\) )?(.+)$}
   664    db transaction {
   665      db eval {DELETE FROM checklist}
   666      set i 0
   667      foreach line [split $txt \n] {
   668        set line [string trimright $line]
   669        if {$line==""} continue
   670        if {[regexp $re $line all a h t]} {
   671          if {$h==""} {unset h} {scan $h (%x) h}
   672          if {$a=="#"} {
   673            set i [expr {(int($i/100)+1)*100}]
   674          } elseif {$a=="##"} {
   675            if {$i==0} {error "\"##\" before any \"#\""}
   676            incr i
   677          } else {
   678            error "unknown line prefix: \"$a\""
   679          }
   680          db eval {INSERT INTO checklist(seq,itemid,txt)
   681                   VALUES($i,COALESCE($h,abs(random())),$t)}
   682        } else {
   683          error "illegal checklist line: \"$line\""
   684        }
   685      }
   686    }
   687  }
   688  
   689  # The /cklistedit page allows the administrator to edit the items on
   690  # the checklist.
   691  #
   692  proc wapp-page-cklistedit {} {
   693    if {[checklist-common-header]} return
   694    if {![wapp-param CKLIST_ADMIN 0]} {
   695      wapp-redirect index
   696      return
   697    }
   698    set cklist [string trim [wapp-param cklist]]
   699    if {$cklist!=""} {
   700      checklist-rebuild-from-text $cklist
   701    }
   702    set x [checklist-as-text]
   703    wapp-trim {
   704      <form method="POST" action="cklistedit">
   705      <p>Edit checklist: <input type="submit" value="Install"><br>
   706      <textarea name="cklist" rows="40" cols="120">%html($x)</textarea>
   707      <br><input type="submit" value="Install">
   708      </form>
   709      </p>
   710    }
   711    catch {db eval COMMIT}
   712    checklist-common-footer 
   713  }
   714  
715 # This dispatch hook checks to see if the first element of the PATH_INFO 716 # is the name of a checklist database. If it is, it makes that database 717 # the OBJECT and shifts a new method name out of PATH_INFO and into 718 # PATH_HEAD for dispatch. 719 # 720 # If the first element of PATH_INFO is not a valid checklist database name, 721 # then change PATH_HEAD to be the database listing method. 722 # 723 proc wapp-before-dispatch-hook {} { 724 global DATADIR 725 set dbname [wapp-param PATH_HEAD] 726 wapp-set-param ROOT_URL [wapp-param BASE_URL] 727 if {[file readable $DATADIR/$dbname.db]} { 728 # an appropriate database has been found 729 wapp-set-param OBJECT $DATADIR/$dbname.db 730 if {[regexp {^([^/]+)(.*)$} [wapp-param PATH_TAIL] all head tail]} { 731 wapp-set-param PATH_HEAD $head 732 wapp-set-param PATH_TAIL [string trimleft $tail /] 733 wapp-set-param SELF_URL /$head 734 } else { 735 wapp-set-param PATH_HEAD {} 736 wapp-set-param PATH_TAIL {} 737 } 738 } else { 739 # Not a valid database. Change the method to list all available 740 # databases. 741 wapp-set-param OBJECT {} 742 if {$dbname!="env"} {wapp-set-param PATH_HEAD listing} 743 } 744 }
745 746 # Start up the web-server 747 wapp-start $::argv