Updated 2013-08-27 10:35:40 by RLE

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