Version 8 of Webadmin for Metakit with Tclhttpd

10/22/2003 Stefan Vogel

I just wanted to get familar with metakits. So I build up a very simply but still useful (at least for me) Webadministration-Interface for MetaKit.

This webadministration Metakit@Web works with Tclhttpd.

With Metakit@Web you can:

create metakit-database-files
create, modify, delete views
create, edit, delete rows
view binaries
test queries ...

Installation is quite simple (as always with Tclhttpd):

Extract the following script or download it from http://www.vogel-nest.de/tcl
Copy the script "mkweb.tcl" to your tclhttpd-custom-directory (may be you have to patch your Tclhttpd so that custom-files are read: http://sourceforge.net/tracker/index.php?func=detail&aid=635083&group_id=12884&atid=112884 )
Create a directory where you place your metakits (let's say: /metakits or c:/metakits)
Adapt the directory in mkweb.tcl (e.g. set the array aConfig(databaseDir) to /metakits or c:/metakits)
restart Tclhttpd
Go to http://<yourdomain>/mkweb

Attention

This Webadmin-interface was developed only for me and my local installation of Tclhttpd.

Currently there is no security implemented! Everyone who can access your webserver can access your metakits!!
Only one user at a time should access Metakit@Web because the configuration-values are globally set (no sessions). Maybe someone wants to make this script session-aware?
Be sure that no spider follows the links on the page (the delete-operation is available as a link, so be careful).

Next steps/Missing features:

subviews are not handled correctly
make it session-aware

You've been warned. But now ... have fun:

 # ------------------------------------------------------------------------------
 # Metakit@Web -- Webadministration-interface for Metakit with Tclhttpd
 # * Simply copy this file to <tclhttpd-path>/custom
 # * Adapt "databaseDir"
 # * Restart Tclhttpd and go to "http://your.domain/mkweb"
 # * Because of security-reasons you should be sure that  nobody has 
 #   access to your Tclhttpd :-) 
 # 
 # 10/22/2003: Revision 0.2 by Stefan Vogel (stefan at vogel-nest dot de) 
 # ------------------------------------------------------------------------------

 package require Mk4tcl
 package require html

 # -------------------------------------------------------
 # | db                     | main
 # | execute/listdb         | execute/listmain (db/view)
 # | ------------------------
 # | views                  |
 # | execute/listviews (db) |
 # |_______________________
 # | config
 # | execute/listconfig
 # |_______________________
 namespace eval  metakit::web {
     variable aConfig 
     array set aConfig {
         prefix mkweb
         databaseDir /metakits
         maxRows {50}
         maxChars {250}
         rowColsTexts {10 20}
         displayBinary 0
         title "Metakit@Web"
     }
     ::html::init [list input.size 15]
     ::html::headTag [subst {link rel="stylesheet" href="/$aConfig(prefix)/mkweb.css"}]
     ::html::headTag [subst {script language="JavaScript" src="/$aConfig(prefix)/mkweb.js" type="text/javascript"></script}]
 }

 # tricky little hack to get the sock-value for this request
 # Cgi_SetEnvAll ist called in direct.tcl from DirectDomain, so I simply
 # link into this call (or you may say: overload this method :-)
 catch {rename Cgi_SetEnvAll _Cgi_SetEnvAll}
 proc Cgi_SetEnvAll {sock path extra url var} {
     upvar 1 $var env
     set env(sock) $sock
     return [::_Cgi_SetEnvAll $sock $path $extra $url $var]
 }

 # plug the given path to Metakit@Web into Tclhttpd
 Direct_Url /$metakit::web::aConfig(prefix) metakit::web::execute

 # Main-method which builds the html-frames
 proc metakit::web::execute {} {
     variable aConfig
     return [generateHtml [subst {<frameset rows="*,70">
 <frameset cols="30%,60%">
   <frameset rows="40%,60%">
     <frame src="$aConfig(prefix)/listdb" name="db" scrolling="yes">
     <frame src="$aConfig(prefix)/listviews" name="views" scrolling="yes">
   </frameset>
     <frame src="$aConfig(prefix)/help" name="main" scrolling="yes">
 </frameset>
   <frame src="$aConfig(prefix)/listconfig" name="config" scrolling="yes">
 </frameset>
 <noframes>
   <h2>Frame Alert</h2>
   <p>This document is designed to be viewed using the frames feature. If you see this message, you are using a non-frame-capable web client.</p>
 </noframes>}] 0]
 }

 proc metakit::web::execute/listdb {args} {
     array set _args $args
     variable aConfig
     set result ""
     set redirect ""
     if {![info exists _args(mode)]} {
         set _args(mode) select
     }
     switch -- [string tolower $_args(mode)] {
         new {
             set result [subst {[::html::h1 "Create metakit"]
 <form action="listdb" method="get">
 [::html::textInputRow "Filename:" filename]<input type="submit" class="button" name="mode" value="Create">
 </form>
 }]
         }
         create {
             if {![info exists _args(filename)] || $_args(filename) == ""} {
                 error "Invalid filename in listdb - create"
             }
             OpenDb $_args(filename)
             CloseDb
             set redirect listdb
         }
         delete {
             if {![info exists _args(db)] || ![file exists [file join $aConfig(databaseDir) $_args(db)]]} {
                 error "Invalid filename in listdb - delete"
             }
             file delete -force [file join $aConfig(databaseDir) $_args(db)]
             set redirect listdb
         }
         select -
         "" {
             append dbList [subst {<tr><th>Filename</th><th>Size</th><th><a href="listdb?mode=new">New</a></th></tr>}]
             if {![file isdirectory $aConfig(databaseDir)]} {
                 set result "<h1>Error</h1>Database-directory: '$aConfig(databaseDir)' does not exist. Please create it or modify <code>mkweb.tcl metakit::web::execute::aConfig(databaseDir)</code>."
             } else {
                 foreach db [set lDb [glob -nocomplain -- $aConfig(databaseDir)/*]] {
                     set _db [file tail $db]
                     append dbList [subst {<tr><td><a href="listviews?db=$_db" target="views">$_db</a></td><td align="right">[format "%.2f kB" [expr [file size $db]/1024.0]]</td>
 <td><a href="listdb?mode=delete&db=$_db" onclick="return linkClick('Really delete complete metakit: $_db?');">Delete</a></td></tr>}]
                 }
                 set result [subst {[::html::h1 "Files"]
 <table>$dbList</table>}]
             }
         }
         default {
             error "Unknown mode '$_args(mode)' for listdb"
         }
     }
     ReturnResult $result $redirect
 }

 proc metakit::web::execute/listviews {args} {
     variable aConfig
     array set _args $args
     if {![info exists _args(mode)]} {
         set _args(mode) select
     }
     if {[info exists _args(db)]} {
         set db $_args(db)
     } else {
         return [generateHtml "<body></body>"]
     }
     set result ""
     set redirect ""
     # set result "<b>$args</b><br>"
     OpenDb $db
     switch -- [string tolower $_args(mode)] {
         select {
             set viewList [subst {<tr><th>View</th><th>Columns</th><th>Datatype</th><th colspan="2"><a href="listviews?db=$db&mode=newview">New View</a></th></tr>}]
             foreach view [set lView [mk::file views db]] {
                 append viewList [subst {<tr><td><a href="listmain?db=$db&view=$view&mode=browse" target="main">$view</a></td><td></td><td></td>
 <td><a href="listviews?db=$db&view=$view&mode=modifyview">Modify</a></td>
 <td><a href="listviews?db=$db&view=$view&mode=delete" onclick="return linkClick('Really delete complete view: $view?');">Delete</a></tr>}]
                 foreach col [mk::view layout db.$view] {
                     foreach {colName datatype} [split $col ":"] {break}
                     append viewList [subst {<tr><td></td><td>$colName</td>
                         <td>[expr {$datatype != "" ? $datatype : "S"}]</td><td></td><td></td></tr>
 }]
                 }
                 append viewList {<tr><td colspan="5"></td></tr>}
             }
             mk::file close db
 append result [subst {[::html::h1 "Views of metakit: '$db'"]
 <table class="dml">$viewList</table>
 <form action="listviews" method="get" target="views">
 <input type="hidden" name="db" value="$db">
 </form>}]
         }
         newview {
             append result [subst {
 <form action="listviews" method="get">
 <input type="hidden" name="db" value="$db">
 Viewname:<br><input type="text" name="viewname" size="30"><br>
 Structure:<br><input type="text" name="structure" size="30"><br>
 <input type="submit" class="button" name="mode" value="Create">
 </form>
 Structure: e.g. id:I name:S street:S salary:F<br>
 :S string<br>:I integer<br>:L long<br>:F float<br>:D double<br>:B binary<br>}]
         }
         create {
             mk::view layout db.$_args(viewname) $_args(structure)
             mk::file commit db
             set redirect "listviews?db=$db"
         }
         delete {
             mk::view delete db.$_args(view)
             mk::file commit db
             set redirect "listviews?db=$db"
         }
         modifyview {
             append result [subst {
 <form action="listviews" method="get">
 <input type="hidden" name="db" value="$db">
 <input type="hidden" name="view" value="$_args(view)">
 [::html::textInputRow "Structure:<br>" structure [mk::view layout db.$_args(view)]]
 <input type="submit" class="button" name="mode" value="Modify">
 </form>
 <b>Modifying a structure may delete the whole content!</b><br>
 Structure: e.g. id:I name:S street:S salary:F<br>
 :S string<br>:I integer<br>:L long<br>:F float<br>:D double<br>:B binary<br>}]
         }
         modify {
             mk::view layout db.$_args(view) $_args(structure)
             mk::file commit db
             set redirect "listviews?db=$db"
         }
         default {
             error "No such mode '$_args(mode)' in listviews"
         }
     }
     CloseDb
     ReturnResult $result $redirect
 }

 # needs db, view-parameter
 proc metakit::web::execute/listmain {args} {
     variable aConfig
     array set _args $args
     if {[info exists _args(db)]} {
         OpenDb [set db $_args(db)]
     } else {
         return [generateHtml ""]
     }
     if {![info exists _args(mode)]} {
         set _args(mode) browse
     }
     if {![info exists _args(query)]} {
         set query ""
     } else {
         set query $_args(query)
     }
     set lStdLink [list db=$db view=$_args(view)]

     set result ""
     set redirect ""
     switch -- [set mode [string tolower $_args(mode)]] {
         query -
         browse {
             # the following parameters are used to browse through content
             # index - startindex
             # count - number of rows to show
             # sort  - either sort or rsort
             # column - sort - column
             set view [mk::view open db.$_args(view)]
             foreach col [mk::view layout db.$_args(view)] {
                 if {[llength [set _col [split $col :]]] > 1} {
                     set aDatatype([lindex $_col 0]) [lindex $_col 1]
                 } else {
                     set aDatatype([lindex $_col 0]) S
                 }
             }
             set lAddLink {}
             # attention, e.g for wikit-database we need to escape some html-chars
             set cmd "mk::select db.$_args(view)"
             if {[info exists _args(sort)]} {
                 append cmd " -$_args(sort) $_args(column)"
                 eval lappend lAddLink [list sort=$_args(sort) column=$_args(column)]
             }
             if {[info exists _args(first)]} {
                 append cmd " -first $_args(first)"
                 lappend lAddLink "first=$_args(first)"
             } else {
                 set _args(first) 0
             }
             set cursor ""
             if {[info exists aConfig(maxRows)] && $aConfig(maxRows) != ""} {
                 append cmd " -count $aConfig(maxRows)"
                 set cursor [AddCursor $_args(first) $aConfig(maxRows) [$view size] "listmain?[join $lStdLink &]&[join $lAddLink &]"]
             }

             set sContent [subst {<tr><th><a href="#" onclick="setChecks(false); return false;">un</a>/ <a href="#" onclick="setChecks(true); return false;">mark</a> all</th><th>index&nbsp;<a href="listmain?[join $lStdLink &]">&uarr;</a></th>}]
             foreach col [mk::view layout db.$_args(view)] {
                 set queryLink "listmain?[join $lStdLink &]&[join $lAddLink &]&column=[lindex [split $col :] 0]&sort="
                 append sContent [subst {<th>$col&nbsp;<a href="${queryLink}sort">&uarr;</a>&nbsp;<a href="${queryLink}rsort">&darr;</a></th>}]
             }
             append sContent [subst {<th><a href="listmain?[join $lStdLink &]&mode=newrow">New row</a></th></tr>}]
             append cmd " $query"
             set i 0
             foreach r [eval $cmd] {
                 append sContent [subst {<tr[expr {[incr i]%2 ? "":" class=\"scnd\""}]><td><input type="checkbox" name="delete_col_$r" value="$i"></td><td><a href="listmain?[join $lStdLink &]&index=$r&mode=edit">$r</a></td>}]
                 foreach {key value} [mk::get db.$_args(view)!$r] {
                     append sContent "<td>[prepareData $value $aDatatype($key) download.bin?db=$db&view=$_args(view)&index=$r&column=$key]&nbsp;</td>"
                 }
                 append sContent [subst {<td><a href="listmain?[join $lStdLink &]&index=$r&mode=delete" onclick="return linkClick('Really delete row: $r?');">Delete</a></tr>\n}]
             }
             foreach {key value} $args {
                 lappend queryParam "$key=$value"
             }
             set result [subst {[::html::h1 "Content of metakit: '$db' view: '$_args(view)'"]
 Total view-size: [$view size] rows<br>
 Query-Command: <em>$cmd</em><br>
 $cursor<br>
 <form name="browse" action="listmain">
 <input type="hidden" name="db" value="$db">
 <input type="hidden" name="view" value="$_args(view)">
 <table class="cnt">$sContent</table><br>
 <input type="submit" class="button" name="mode" value="Delete marked" onclick="return linkClick('Really delete all marked rows?');">
 <p><input type="text" name="query" value="$query" size="30">
 <input type="submit" class="button" name="mode" value="Query"></p>
 E.g. -glob name stefan*<br>
 <table>
 <tr><td><em>prop value</em></td><td>Numeric or case-insensitive match</td></tr>
 <tr><td><em>-min prop value</em></td><td>Property must be greater or equal to value (case is ignored)</td></tr>
 <tr><td><em>-max propvalue</em></td><td>Property must be less or equal to value (case is ignored) 
 </td></tr>
 </em><tr><td><em>-exact prop value</td><td>Exact case-sensitive string match</td></tr>
 <tr><td><em>-glob prop pattern</em></td><td>Match "glob-style" expression wildcard</td></tr>
 <tr><td><em>-globnc prop pattern</em></td><td>Match "glob-style" expression, ignoring case</td></tr>
 <tr><td><em>-regexp prop pattern</em></td><td>Match specified regular expression</td></tr>
 <tr><td><em>-keyword prop word</em></td><td>Match word as free text or partial prefix</td></tr>
 </table>
 </form>
 $cursor}]
         }
         newrow - 
         edit {
             if {$mode == "newrow"} {
                 set msg [subst {<h1>New row in view '$_args(view)' in metakit '$db'</h1>
 <table class="cnt"><tr>}]
                 set index ""
             } else {
                 # mode == edit
                 set msg [subst {<input type="hidden" name="index" value="$_args(index)">
 <h1>Edit row $_args(index) in view '$_args(view)' in metakit '$db'</h1>
 <table class="cnt"><tr><th>index</th>}]
                 set index "<td>$_args(index)</td>"
             }
             set layout [mk::view layout db.$_args(view)]
             append result [subst {<form action="saferow" method="post" enctype="multipart/form-data">
 <input type="hidden" name="db" value="$db">
 <input type="hidden" name="view" value="$_args(view)">
 $msg}]
             foreach col $layout {
                 if {[llength [set _col [split $col :]]] > 1} {
                     set aDatatype([lindex $_col 0]) [lindex $_col 1]
                 } else {
                     set aDatatype([lindex $_col 0]) S
                 }
                 append result "<th>$col</th>"
             }
             append result </tr>\n<tr>$index
             if {$mode == "newrow"} {
                 foreach col $layout {
                     set col [lindex [split $col :] 0]
                     append result [subst {<td>[prepareInput $col $aDatatype($col)]</td>}]
                 }
                 append result {</tr></table><input type="hidden" name="mode" value="create"><input type="submit" class="button" value="Create"></form>}
             } else {
                 # mode == edit
                 set lRow [mk::get db.$_args(view)!$_args(index)]
                 foreach {col value} $lRow {
                     append result [subst {<td>[prepareInput $col $aDatatype($col) $value]</td>}]
                 }
                 append result [subst {</tr></table><br><input type="hidden" name="mode" value="safe"><input type="submit" class="button" value="Safe"></form>}]
             }
         }
         {delete marked} -
         delete {
             # action from delete
             if {[info exists _args(index)]} {
                 # delete a row (given by index from view)
                 mk::row delete db.$_args(view)!$_args(index)
             } else {
                 # marked multiple elements to delete (via checkboxes)
                 set lResult {}
                 foreach elem [array names _args delete_col_*] {
                     set i [string range $elem 11 end]
                     mk::row delete db.$_args(view)!$i
                 }
             }
             set redirect "listmain?[join $lStdLink &]"
         }
         default {
             error "No such mode '$_args(mode)' in listmain"
         }
     }
     CloseDb
     ReturnResult $result $redirect 
 }

 # issued from edit/safe or new row/create
 proc metakit::web::execute/saferow {args} {
     set result ""
     set redirect ""
     foreach {n v} [ncgi::nvlist] {
         set _args($n) [lindex $v 1]
     }
     OpenDb [set db $_args(db)]
     set lStdLink [list db=$db view=$_args(view)]
     switch -- [string tolower $_args(mode)] {
         create {
             # action from newrow
             foreach var [array names _args colvalue_*] {
                 lappend lNewRow [string range $var 9 end] [set _args($var)]
             }
             append result "args: $args lNewRow: $lNewRow ncgi::value colvalue_data: [ncgi::value colvalue_data]"
             set vw [mk::view open db.$_args(view)]
             eval mk::row append db.$_args(view) $lNewRow
             set redirect "listmain?[join $lStdLink &]"
         }
         safe {
             # action from clicking "safe" in edit-form
             foreach var [array names _args colvalue_*] {
                 set index [string range $var 9 end]
                 append result "index<br> info exists _args(bool_colvalue_$index): [info exists _args(bool_colvalue_$index)]<br>"
                 if {[info exists _args(bool_colvalue_$index)]} {
                     append result "_args(bool_colvalue_$index): $_args(bool_colvalue_$index)<br>"
                 }
                 if {![info exists _args(bool_colvalue_$index)] || $_args(bool_colvalue_$index) != 1} {
                     lappend lRow $index [set _args($var)]
                 }
             }
             append result "lRow: $lRow"
             eval mk::set db.$_args(view)!$_args(index) $lRow
             set redirect "listmain?[join $lStdLink &]"
         }
     }
     CloseDb
     ReturnResult $result $redirect
 }

 proc metakit::web::execute/download.bin {args} {
     array set _args $args
     set ::metakit::web::execute/download.bin application/octet-stream
     OpenDb $_args(db)
     set result [mk::get db.$_args(view)!$_args(index) $_args(column)]
     CloseDb
     return $result
 } 

 proc metakit::web::execute/listconfig {args} {
     variable aConfig
     array set _args $args
     set result ""
     set redirect ""
     if {[info exists _args(mode)] && $_args(mode) == "safe"} {
         # set retrieved values into config-array and go back
         foreach var {maxRows maxChars displayBinaries} {
             if {[info exists _args($var)]} {
                 set aConfig($var) $_args($var)
             } else {
                 unset -nocomplain aConfig($var)
             }
         }
         set aConfig(rowColsTexts) [list $_args(rowsText) $_args(colsText)]
         set redirect listconfig
     } else {
         # browse-mode
         set result [subst {<table><tr><td><b>Configuration:</b></td><td>
 <form action="listconfig" method="get"><input type="hidden" name="mode" value="safe">
 Rows/Cols for edit-textareas: <input type="text" name="rowsText" value="[lindex $aConfig(rowColsTexts) 0]" size="2">/
 <input type="text" name="colsText" value="[lindex $aConfig(rowColsTexts) 1]" size="2">
             Display Binaries? <input type="checkbox" name="displayBinaries" value="1"[expr {[info exists aConfig(displayBinaries)] && $aConfig(displayBinaries) == 1 ? " checked" : ""}]><br>
 Display max. rows of view/characters of view-content: <input type="text" name="maxRows" value="$aConfig(maxRows)" size="2">/
 <input type="text" name="maxChars" value="$aConfig(maxChars)" size="2">
 <input type="submit" class="button" value="Go">
 &nbsp; <a href="help" target="main">Help</a></form></td></tr></table>}]
     }
     ReturnResult $result $redirect
 }

 ################################################################################
 # Help
 proc metakit::web::execute/help {} {
     variable aConfig
     set result [subst {<center><h1>Welcome to Metakit@Web</h1></center>
 <p>Just to get myself familar with metakit I tried to locate a good "viewer".
 But unfortunately all those metakit-viewers around either don't work or they don't do what I want.</p>
 <p>That was the time I decided to write a little web-frontend (nowadays it's popular to have a web-frontend 
 for almost anything, e.g. MySql). But because the web-frontend should be as easy as possible 
 I chosed Tcl and the Tcl-Webserver (Tclhttpd) for this purpose.</p>
 <p>And what should I say? Tclhttpd is the coolest webserver I've ever seen :-)</p>
 Features of Metakit@Web are:
 <ul><li>easy installation in Tclhttpd (only one file)</li>
 <li>easy editing, manipulating metakit-files (useful for rapid-prototyping).</li></ul>
 Missing features are (resp. pay ATTENTION!!):
 <ul><li>no authorization, everybody can modify or delete the metakit-files (this tool is only meant to be
 used by you on your local-machine)</li>
 <li>no support for subviews</li>
 <li>only useful for one user (no sessions)</li>
 <li>Only Javascript-confirmation for deleting. Site should not be spidered, because if a spider follows
 a "delete"-link ... boom!!</li>
 </ul>
 <h2>Installation/Configuration</h2>
 <p>As you seem to be able to read this, you have successfully installed Metakit@Web.<br>
 Just to mention a few things:</p>
 <p>You should create a directory where you place your metakit-files which should be editable from
 Metakit@Web. This directory has to be configured in the <code>mkweb.tcl</code>-file 
 (Variable: <code>aConfig(databaseDir)</code> currently set to: <code>$aConfig(databaseDir)</code>).</p>
 <p>Furthermore you can set the <code>aConfig(prefix)</code> (currently: <code>$aConfig(prefix)</code>). 
 This variable sets the url-prefix under which you can access Metakit@Web, e.g. now it is:<br>
 <a href="http://$::env(HTTP_HOST)/$aConfig(prefix)">http://$::env(HTTP_HOST)/$aConfig(prefix)</a>.</p>
 <p>You can also configure some values via the configuration-frame below. Simply enter a different value
 and click "Go". Afterwards you should "reload" the pages in which you expect the changes.</p>
 <p>Configuration-options (see below in configuration-frame) are:
 <table>
 <tr><td>Rows/Cols for edit-textareas</td><td>The size of the textarea when editing (:S - string)-values.
 If you have stored large strings it may make sense to enlarge the size. </td></tr>
 <tr><td>Max. rows of view</td><td>How many rows of a view should be displayed? If you set this to "" all
 rows will be shown (possibly only a good idea for small views).</td></tr>
 <tr><td>Max. characters of view-content</td><td>When viewing the content of a view, all string-values will
 be truncated to the size given here. If you want to see the full length, set this value to "".</td></tr>
 </table>
 <h2>General remarks</h2>
 <p>The frames of Metakit@Web looks like this
 <table border="1" width="100%">
 <tr><td>DB-frame<br>This lists all the files from <code>aConfig(databaseDir)</code>. Be careful that you are using metakits here. Deleting a database will delete the file physically!</td><td rowspan="2">Main-frame<br>
 Not "mainframe" :-) This frame displays the content of the views (and the help).</td></tr>
 <tr><td>View-frame<br>If you select a file from the DB-frame, the views and the structure of the views will be shown here. You can modify the views.</td></tr>
 <tr><td colspan="2">configuration-frame<br>
 Common configuration-options to be changed globally.</td></tr>
 </table></p>
 <p>In general the navigation (back, refresh, ..) is left to you and your browser, so you won't find any 
 "back"-buttons in Metakit@Web.<br>
 Normally the names of database-files, view-names, row-indices link to the content of the item.<br>
 The last column of the table (database, views or rows) contains the "New ..."-link for each row an editing link.</p>
 <p>Usually you go to the "File/database"-frame, select a file, go to the "View"-frame and select a view (the content
 is displayed in the main-area).
 <h2>Thanks</h2>
 <p>To Jean-Claude Wippler for his cool <a href="http://www.equi4.com/metakit.html" target="_blank">Metakit</a>
 and the whole Tcl-community for their never-ending patience and helpfulness comments.
 You can find this script on the <a href="http://wiki.tcl.tk/Stefan%20Vogel">Tcl'ers Wiki</a> or go to my <a href="http://www.vogel-nest.de/tcl" target="_blank">Homepage</a>.</p>
 <pre>This script is free software.
 But don't blame me if something get's wrong.
 </pre>
 <p>Suggestions or bug-fixes are always welcome, simply drop me an email or edit the script on the Wiki.<br>
 Stefan Vogel -- stefan at vogel-nest dot de</p>
     }]
     return [generateHtml $result]
 }

 ################################################################################
 # CSS and JS

 proc metakit::web::execute/mkweb.css {} {
     set ::metakit::web::execute/mkweb.css text/css
     set result {body { font-family:Arial,sans-serif; font-size:10pt; }
 h1 { font-size:14pt; color:#000080; }
 h2 { font-size:12pt; color:#000080; }
 td { font-family:Arial,sans-serif; font-size:10pt; vertical-align:top; }
 th { font-family:Arial,sans-serif; font-size:10pt; vertical-align:top; }
 .dml td,.cnt td { border:1px solid black; }
 .dml th { border:1px solid black; }
 .cnt th { border:1px solid black; background-color:#a4a4ff; color:#ffffff; }
 .scnd { background-color:#d9d9ff; }
 .button { background-color:#a4a4ff; color:#ffffff; border:1px solid black; font-weight:bold; }
     }
     return $result
 }

 proc metakit::web::execute/mkweb.js {} {
     set ::metakit::web::execute/mkweb.js application/x-javascript
     set result {
 function linkClick(msg) {
   return confirm(msg);
 }
 function setChecks(check) {
   var form = document.browse;
   for (var c = 0; c < form.elements.length; c++)
     if (form.elements[c].type == 'checkbox')
       form.elements[c].checked = check;
 }
 }
     return $result
 }
 #################################################################################
 # Helperfunctions

 # TODO add different types
 proc metakit::web::prepareData {text datatype link} {
     variable aConfig
     set result $text
     # datatype: $datatype -- $text"
     if {[info exists aConfig(displayBinaries)] && $aConfig(displayBinaries) == 1} {
         # treat binaries as string
         set datatype S
     }
     switch -- [string tolower $datatype] {
         b {
             # only set to "--" if there is anything in this binary column
             if {[string length $text]} {
                 set result [subst {<em>not displayed</em><br><a href="$link">Download</a>}]
             }
         }
         default {
             if {[info exists aConfig(maxChars)]
                 && $aConfig(maxChars) != ""
                 && [string length $text] > $aConfig(maxChars)} {
                 set result [string range $text 0 $aConfig(maxChars)]...
             }
             set result [string map {< &lt;} $result]
         }
     }
     # avoid html-confusion
     return $result
 }

 proc metakit::web::prepareInput {col datatype {value ""}} {
     variable aConfig
     if {[info exists aConfig(displayBinaries)] && $aConfig(displayBinaries) == 1} {
         # treat binaries as string
         set datatype S
     }
     switch -- [string tolower $datatype] {
         i - l - f - d {
             set result [::html::textInput colvalue_$col $value]
         }
         b {
             set result [subst {<input type="file" name="colvalue_$col">}]
             if {$value != ""} {
                 append result [subst {<br><input type="checkbox" name="bool_colvalue_$col" value="1" checked> Leave value as is.<p>There are 3 alternatives here:<ul>
 <li>You want to change the binary value of this row: Upload a new file and "deselect" the checkbox.</li>
 <li>Don't touch the binary value of this row: Select checkbox (default).</li>
 <li>Delete the value of this row: "Deselect" the checkbox and don't upload a file.</li></ul>
 The checkbox has priority, so if the checkbox is selected the binary value of this row won't be changed.</p>}]
             }
         }
         default {
             # S
             set result [::html::textarea colvalue_$col "rows=\"[lindex $aConfig(rowColsTexts) 0]\" cols\"[lindex $aConfig(rowColsTexts) 1]\"" $value]
         }
     }
     return $result
 }

 proc metakit::web::OpenDb {filename} {
     variable aConfig
     catch {mk::file close db}
     mk::file open db [file join $aConfig(databaseDir) $filename]
 }

 proc metakit::web::CloseDb {} {
     catch {mk::file close db}
 }

 proc metakit::web::ReturnResult {result {redirect ""}} {
     variable aConfig
     if {$redirect != ""} {
         Httpd_RedirectSelf /$aConfig(prefix)/$redirect $::env(sock)
     } else {
         return [generateHtml $result]
     }
 }

 proc metakit::web::AddCursor {pos count maxCount link} {
     set result ""
     for {set i -1} {[expr $i+$count+1]<$maxCount} {incr i $count} {
         set str "[expr $i+1] - [set ipc [expr $i + $count]]"
         if {$pos>=$ipc || $pos<$i} {
             set str [subst {<a href="$link&first=[expr $i+1]">$str</a>}]
         }
         append result "&nbsp;$str"
     }
     return $result
 }

 proc metakit::web::generateHtml {body {withBodyTag 1}} {
     variable aConfig
     if {$withBodyTag} {set body <body>$body</body>}
     return [::html::head $aConfig(title)]$body\n</html>
 }

Wow! -jcw

rmax - This looks very nice indeed!

But I keep getting the following error whenever I invoke a link, that changes anything (creating/deleting databases, modifying views, adding rows, etc.):

 can't read "::env(sock)": no such variable
    while executing
 "Httpd_RedirectSelf /$aConfig(prefix)/$redirect $::env(sock)"
    (procedure "ReturnResult" line 4)
    invoked from within
 "ReturnResult $result $redirect"
    (procedure "metakit::web::execute/listdb" line 51)
    invoked from within
 "metakit::web::execute/listdb mode delete db test"
    invoked from within
 "catch $cmd result"
    invoked from within
 "DirectRespond $sock $code $result $type"
    (procedure "DirectDomain" line 29)
    invoked from within
 "DirectDomain metakit::web::execute sock8 /listdb"
    ("eval" body line 1)
    invoked from within
 "eval $Url(command,$prefix) [list $sock $suffix]"

And may I suggest to remove the actual code from this page and just leave a link to the Tcl file on your page. To me it feels a bit too large for a wiki page. This would also save you the work of updating the wiki page every time you improve the script.

[ Category Tclkit | Category Database | Category Internet ]