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:
Installation is quite simple (as always with Tclhttpd):
Attention
This Webadmin-interface was developed only for me and my local installation of Tclhttpd.
Next steps/Missing features:
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 <a href="listmain?[join $lStdLink &]">↑</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 <a href="${queryLink}sort">↑</a> <a href="${queryLink}rsort">↓</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] </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"> <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 {< <} $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 " $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]"
Also, 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.