MkBugs

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

If 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 test

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

--BAJ 5 Dec 2004 -- fixed bug in switching category for summary display


JM 27 Mar 2012 - I am using windows, to play a little bit with this, I used:

 ::mkbugs::initDatabase testdb /testbugs.db

as 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