.Just place the following script in your custom directory (of tclhttpd) See the last line to init databaseTest tracker at http://www.onemoonscientific.com/mkbugs/testdbIf you attempt to reassign a bug to a different category in the test tracker it will ask for a user name and password: Use test and testNote: this is the very first version of this software, bugs in MkBugs are likely.-- BAJ 2 Dec 2004-- BAJ 3 Dec 2004 -- updated with new access control scheme and fixed regexp check for invalid characters--BAJ 5 Dec 2004 -- fixed bug in switching category for summary displayJM 27 Mar 2012 - I am using windows, to play a little bit with this, I used:
::mkbugs::initDatabase testdb /testbugs.dbas the last line of code, and the database was created at c:\, after pointing the web browser to:
http://localhost:8015/mkbugs/testdb
MkBugs Docs for Users
package require Mk4tcl
package require ncgi
Url_PrefixInstall /mkbugs [list MkBugsDomain /mkbugs]
proc MkBugsDomain {prefix sock suffix} {
upvar #0 Httpd$sock data
if {![regexp {^[0-9a-zA-Z/_*]+$} $suffix]} {
Httpd_ReturnData $sock text/plain "Invalid characters in url suffix"
}
set args [split [string trim $suffix /] /]
if {[llength $args] == 0} {
Httpd_ReturnData $sock text/plain "Must specifiy a database in url"
return
}
set db [lindex $args 0]
if {![::mkbugs::checkAccess $sock $db access]} {
return
}
if {[llength $args] == 1} {
Httpd_ReturnData $sock text/html [::mkbugs::wrapBody MkBugs [::mkbugs::mainBar $db]]
return
}
set cmd [lindex $args 1]
if {$cmd eq "submit_report"} {
::ncgi::reset $data(query)
set cgilist [::ncgi::nvlist]
if {[catch [list ::mkbugs::submitReport $db $cgilist] result]} {
Httpd_ReturnData $sock text/html $result
} else {
Httpd_Redirect [Httpd_SelfUrl /mkbugs/$db/summary/incoming/end] $sock
}
return
} elseif {$cmd eq "report"} {
Httpd_ReturnData $sock text/html [::mkbugs::wrapBody "New Bug" [::mkbugs::makeReportPage $db]]
return
} elseif {$cmd eq "note"} {
if {[llength $args] < 3} {
Httpd_ReturnData $sock text/plain "No row for note"
} else {
set index [lindex $args 2]
::ncgi::reset $data(query)
set cgilist [::ncgi::nvlist]
::mkbugs::addNote $db $index $cgilist
Httpd_ReturnData $sock text/html [::mkbugs::wrapBody "New Bug" [::mkbugs::makeShowPage $db $index]]
}
return
} elseif {$cmd eq "show"} {
if {[llength $args] < 3} {
Httpd_ReturnData $sock text/plain "No row for show"
} else {
set first [lindex $args 2]
::ncgi::reset $data(query)
set cgilist [ncgi::nvlist]
set first [::mkbugs::processShow $sock $args $cgilist]
Httpd_ReturnData $sock text/html [::mkbugs::wrapBody "Display Bug" [::mkbugs::makeShowPage $db $first]]
}
return
} elseif {$cmd eq "summary"} {
::ncgi::reset $data(query)
set cgilist [ncgi::nvlist]
foreach "category first count" [::mkbugs::processSummary $sock $args $cgilist] {}
Httpd_ReturnData $sock text/html [::mkbugs::wrapBody Summary [::mkbugs::makeSummaryPage $db $category $first $count]]
return
} else {
Httpd_ReturnData $sock text/plain "Invalid command"
return
}
}
namespace eval ::mkbugs {
variable BugCategories "incoming bugs bugs_fixed feature_request feature_added low_priority duplicates"
variable requiredFields {comments subject}
proc initDatabase {dbHandle dbFile} {
catch "::mk::file open $dbHandle $dbFile"
set properties {id subject comments time category os version submitted_by full_name description {notes note} resolvedin audit priority}
set views [::mk::file views $dbHandle]
if {[lsearch $views bugs] == -1} {
::mk::view layout $dbHandle.bugs $properties
}
::mk::view layout $dbHandle.bugs $properties
if {[lsearch $views reportfields] == -1} {
::mk::view layout $dbHandle.reportfields "name var type params values"
::mk::row append $dbHandle.reportfields name subject var subject type textInputRow params {size=60}
::mk::row append $dbHandle.reportfields name "submitted by" var submitted_by type textInputRow params {size=40}
::mk::row append $dbHandle.reportfields name "software version" var version type textInputRow params {size=20}
::mk::row append $dbHandle.reportfields name "operating system" var os type select values {
{} {Not Specified}
{Linux} {Linux}
{Windows} {Windows}
{Solaris} {Solaris}
{Mac OS X} {MacOSX}
}
::mk::row append $dbHandle.reportfields name "priority" var priority type selectPlain values {
low
medium
high
extreme
}
::mk::row append $dbHandle.reportfields name "comments" var comments type textarea params {rows=10 cols=50}
}
if {[lsearch $views showfields] == -1} {
::mk::view layout $dbHandle.showfields "name var type params values"
::mk::row append $dbHandle.showfields name subject var subject type textInputRow params {size=60}
::mk::row append $dbHandle.showfields name "submitted by" var submitted_by type textInputRow params {size=40}
::mk::row append $dbHandle.showfields name "time" var time type textInputRow params {size=40}
::mk::row append $dbHandle.showfields name "software version" var version type textInputRow params {size=20}
::mk::row append $dbHandle.showfields name "operating system" var os type select values
::mk::row append $dbHandle.showfields name "priority" var priority type select values
::mk::row append $dbHandle.showfields name "comments" var comments type textarea params {rows=10 cols=50}
}
::mk::file commit $dbHandle
}
proc makeReportPage {db} {
append result [mainBar $db]
append result "
<b>Enter Bug Report</b>
<p>
<form action=/mkbugs/$db/submit_report method=POST>
<table>
"
set size [::mk::view size $db.reportfields]
set rowData ""
for {set i 0} {$i < $size} {incr i} {
array set fields [::mk::get $db.reportfields!$i]
switch $fields(type) {
textInputRow {
append rowData [html::textInputRow $fields(name) $fields(var) {} $fields(params)]
}
select {
append rowData "
[html::row $fields(var) [html::select $fields(var) 1 $fields(values)]]
"
}
selectPlain {
append rowData "
[html::row $fields(var) [html::selectPlain $fields(var) 1 $fields(values)]]
"
}
textarea {
append rowData [html::paramRow [list $fields(name) [html::textarea $fields(var) $fields(params)]]]
}
}
}
append result $rowData
append result {
</table>
<input type=submit>
}
append result [html::end]
return $result
}
proc submitReport {db cgilist} {
variable requiredFields
set newRow $cgilist
lappend newRow category
lappend newRow incoming
lappend newRow time
lappend newRow [clock seconds]
array set rowArray $cgilist
foreach requiredField $requiredFields {
if {![info exists rowArray($requiredField)] || ([string trim $rowArray($requiredField)] eq "")} {
error "No data for field $requiredField"
}
}
eval [linsert $newRow 0 ::mk::row append $db.bugs]
::mk::file commit $db
return
}
proc processShow {sock suffixArgs cgilist} {
array set cgivals $cgilist
set index 0
set db [lindex $suffixArgs 0]
set last [expr {[::mk::view size $db.bugs]-1}]
if {[llength $suffixArgs] > 2} {
set index [lindex $suffixArgs 2]
}
if {[info exists cgivals(submit)]} {
switch $cgivals(submit) {
Change {
set newList "newCat$index $cgivals(catSelect)"
changeCategories $sock $db $newList
}
First {
set index 0
}
Last {
set index $last
}
Next {
incr index 1
if {$index > $last} {
set index $last
}
}
Previous {
incr index -1
if {$index < 0} {
set index 0
}
}
}
}
return $index
}
proc makeShowPage {db row} {
array set data [::mk::get $db.bugs!$row]
append result [mainBar $db]
set action "action=/mkbugs/$db/show/$row method=POST"
append result "
[navigateBar $action]
<br>
<br>
"
append result "
<table border=\"2\">
"
append result "
[::html::openTag tr]
[::html::cell {valign="top" width="100"} "Bug ID"]
[::html::cell {valign="top" width="300"} $row]
[::html::closeTag]
"
append result "
[::html::openTag tr]
[::html::cell {valign="top" width="100"} category]
[::html::cell {valign="top" width="300"} [categorySwitcher Change $data(category) $action]]
[::html::closeTag]
"
set size [::mk::view size $db.showfields]
set rowData ""
for {set i 0} {$i < $size} {incr i} {
array set fields [::mk::get $db.showfields!$i]
append result "
[::html::openTag tr]
[::html::cell {valign="top" width="100"} $fields(name)]
[::html::cell {valign="top" width="300"} $data($fields(var))]
[::html::closeTag]
"
}
set vr $db.bugs!$row.Notes
set size [::mk::view size $vr]
for {set i 0} {$i < $size} {incr i} {
set note [::mk::get ${vr}!$i Note]
append result "
[::html::openTag tr]
[::html::cell {valign="top" width="100"} Note$i]
[::html::cell {valign="top" width="300"} $note]
[::html::closeTag]
"
}
set action "action=/mkbugs/$db/note/$row"
append result "
[::html::openTag form $action]
[::html::openTag tr]
[::html::cell {valign="top" width="100"} [::html::submit "New Note"]]
[::html::cell {valign="top"} [::html::textarea note "rows=10 cols=50"]]
[::html::closeTag]
[::html::closeTag]
"
append result {
</table>
}
return $result
}
proc addNote {db row cgilist} {
array set cgivals $cgilist
if {[info exists cgivals(note)] && ([string trim $cgivals(note)] ne "")} {
set vr $db.bugs!$row.notes
::mk::row append $vr note $cgivals(note)
}
}
proc processSummary {sock suffixArgs cgilist} {
array set cgivals $cgilist
set category *
set first 0
set count 10
set db [lindex $suffixArgs 0]
set last [expr {[::mk::view size $db.bugs]-1}]
if {[llength $suffixArgs] > 2} {
set category [lindex $suffixArgs 2]
}
if {[llength $suffixArgs] > 3} {
set first [lindex $suffixArgs 3]
}
if {[llength $suffixArgs] > 4} {
set count [lindex $suffixArgs 4]
}
if {[info exists cgivals(submit)]} {
switch $cgivals(submit) {
Search {
return [list $cgivals(searchCat) search $cgivals(searchString)]
}
Update {
changeCategories $sock $db $cgilist
}
Next {
incr first $count
}
First {
set first 0
}
Last {
set first [expr {$last-$count+1}]
if {$first < 0} {
set first 0
}
}
Previous {
incr first [expr {-$count}]
if {$first < 0} {
set first 0
}
}
Refresh {
if {[info exists cgivals(catSelect)]} {
set category $cgivals(catSelect)
set first 0
}
}
}
}
return [list $category $first $count]
}
proc makeSummaryPage {db category arg1 arg2} {
variable BugCategories
set action "action=/mkbugs/$db/report"
append result "
[::html::openTag form $action]
[html::submit "New Bug" ]
[::html::closeTag]
"
set action "action=/mkbugs/$db/summary/$category/$arg1 method=POST"
append result "
Bug Category
[categorySwitcher Refresh $category "/mkbugs/$db/summary method=POST"]
[navigateBar $action]
[searchBar $category "/mkbugs/$db/summary/$category/search method=POST"]
<br>
<br>
"
append result "
[::html::openTag form $action]
[html::submit Update ]
"
if {$arg1 ne "search"} {
set count $arg2
if {$arg1 eq "end"} {
set size [::mk::view size $db.bugs]
#fixme following assumes all in bugs in particular category
set first [expr {$size-$count}]
} else {
set first $arg1
}
set rows [::mk::select $db.bugs -globnc category $category -first $first -count $count]
} else {
set rows [::mk::select $db.bugs -globnc category $category -keyword comments $arg2 -count 30]
}
append result "
<table border=\"2\">
"
foreach row $rows {
array set data [::mk::get $db.bugs!$row]
set catSelectData [html::selectPlain newCat$row par $BugCategories $data(category)]
append result "
[::html::openTag tr]
[::html::cell {valign="top" width="50"} "<a href=/mkbugs/$db/show/$row>$row</a>"]
[::html::cell {valign="top" width="100"} $catSelectData]
[::html::cell {valign="top" width="150"} [clock format $data(time)]]
[::html::cell {valign="top" width="500"} $data(subject)]
[::html::closeTag]
"
}
append result "
[::html::closeTag]
"
append result {
</table>
}
return $result
}
proc wrapBody {title body} {
append result [html::head $title]
append result [html::bodyTag]
append result "
<br>
$body
"
append result [html::end]
return $result
}
proc mainBar {db} {
set result "
[::html::openTag table]
[::html::openTag tr]
[::html::cell {valign="top" width="200"} "<a href=/mkbugs/$db/summary>Summaries</a>"]
[::html::cell {valign="top" width="200"} "<a href=/mkbugs/$db/report>New Bug</a>"]
[::html::closeTag]
[::html::closeTag]
"
}
proc navigateBar {action} {
set result "
[::html::openTag form $action]
[html::submit First ]
[html::submit Previous ]
[html::submit Next ]
[html::submit Last ]
[::html::closeTag]
"
}
proc searchBar {category action} {
variable BugCategories
set result "
[::html::openTag form $action]
Look for
[html::textInput searchString {} {size=40}]
in category
[html::selectPlain searchCat {} [concat * $BugCategories] $category]
[html::submit Search ]
[::html::closeTag]
"
}
proc categorySwitcher {label category action} {
variable BugCategories
set result "
[::html::openTag form $action]
[html::selectPlain catSelect par [concat * $BugCategories] $category]
[html::submit $label ]
[::html::closeTag]
"
}
proc changeCategories {sock db cgilist} {
if {![checkAccess $sock $db admin]} {
return
}
foreach "name value" $cgilist {
if {[regexp {newCat([0-9]+)} $name all row]} {
::mk::set $db.bugs!$row category $value
}
}
}
proc checkAccess {sock db ext} {
set dbsOpen [::mk::file open]
set dbIndex [lsearch -exact $dbsOpen $db]
if {$dbIndex == -1} {
Httpd_ReturnData $sock text/plain "Database $db doesn't exist"
return 0
}
set dbFile [lindex $dbsOpen [incr dbIndex]]
set dbFileRoot [file root $dbFile]
set htfile $dbFileRoot.$ext
if {[file exists $htfile]} {
if {![AuthVerifyBasic $sock $htfile]} {
Httpd_ReturnData $sock text/plain "You are not authorized to access this data"
return 0
}
}
return 1
}
}
# ::mkbugs::initDatabase testdb /home/wiki/db/testbugs.db