MkBugs is a simple bug manager that uses tclhttpd and metakit. Design somewhat inspired by Jitterbug.
Just place the following script in your custom directory (of tclhttpd) See the last line to init database
Test tracker at http://www.onemoonscientific.com/mkbugs/testdb
Note: 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
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 ::mk::row append $db.bugs $newRow
::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
}
}
Change {
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