#! /usr/bonsaitools/bin/mysqltcl # -*- Mode: tcl; indent-tabs-mode: nil -*- # # The contents of this file are subject to the Mozilla Public License # Version 1.0 (the "License"); you may not use this file except in # compliance with the License. You may obtain a copy of the License at # http://www.mozilla.org/MPL/ # # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the # License for the specific language governing rights and limitations # under the License. # # The Original Code is the Bugzilla Bug Tracking System. # # The Initial Developer of the Original Code is Netscape Communications # Corporation. Portions created by Netscape are Copyright (C) 1998 # Netscape Communications Corporation. All Rights Reserved. # # Contributor(s): Terry Weissman puts "Content-type: multipart/x-mixed-replace;boundary=ThisRandomString" puts "" puts "--ThisRandomString" proc InitMessage {str} { global initstr append initstr "$str\n" puts "Content-type: text/plain" puts "" puts $initstr puts "" puts "--ThisRandomString" flush stdout } # The below "if catch" stuff, if uncommented, will trap any error, and # mail the error messages to terry. What a hideous, horrible # debugging hack. # if {[catch { source "CGI.tcl" ConnectToDatabase if {![info exists FORM(cmdtype)]} { # This can happen if there's an old bookmark to a query... set FORM(cmdtype) doit } switch $FORM(cmdtype) { runnamed { set buffer $COOKIE(QUERY_$FORM(namedcmd)) ProcessFormFields $buffer } editnamed { puts "Content-type: text/html Refresh: 0; URL=query.cgi?$COOKIE(QUERY_$FORM(namedcmd)) What a hack. Loading your query named $FORM(namedcmd)..." exit } forgetnamed { puts "Set-Cookie: QUERY_$FORM(namedcmd)= ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT Content-type: text/html Forget what? OK, the $FORM(namedcmd) query is gone.

Go back to the query page." exit } asnamed { if {[regexp {^[a-zA-Z0-9_ ]+$} $FORM(newqueryname)]} { puts "Set-Cookie: QUERY_$FORM(newqueryname)=$buffer ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT Content-type: text/html OK, done. OK, you now have a new query named $FORM(newqueryname).

Go back to the query page." } else { puts "Content-type: text/html Picky, picky. Query names can only have letters, digits, spaces, or underbars. You entered \"$FORM(newqueryname)\", which doesn't cut it.

Click the Back button and type in a valid name for this query." } exit } asdefault { puts "Set-Cookie: DEFAULTQUERY=$buffer ; path=/ ; expires=Sun, 30-Jun-99 00:00:00 GMT Content-type: text/html OK, default is set. OK, you now have a new default query.

Go back to the query page, using the new default." exit } } proc qadd { item } { global query append query "$item" } proc DefCol {name k t {s ""} {q 0}} { global key title sortkey needquote set key($name) $k set title($name) $t if {![cequal $s ""]} { set sortkey($name) $s } set needquote($name) $q } DefCol resolved_ts "bugs.resolved_ts" DateResolved bugs.resolved_ts DefCol verified_ts "bugs.verified_ts" DateVerified bugs.verified_ts DefCol opendate "date_format(bugs.creation_ts,'Y-m-d')" Opened bugs.creation_ts DefCol changeddate "date_format(bugs.delta_ts,'Y-m-d')" Changed bugs.delta_ts DefCol severity "substring(bugs.bug_severity, 1, 3)" Sev bugs.bug_severity DefCol priority "substring(bugs.priority, 1, 3)" Pri bugs.priority DefCol platform "substring(bugs.rep_platform, 1, 3)" Plt bugs.rep_platform DefCol owner "assign.login_name" Owner assign.login_name DefCol reporter "report.login_name" Reporter report.login_name DefCol status "substring(bugs.bug_status,1,4)" State bugs.bug_status DefCol resolution "substring(bugs.resolution,1,4)" Res bugs.resolution DefCol summary "substring(bugs.short_desc, 1, 60)" Summary {} 1 DefCol summaryfull "bugs.short_desc" Summary {} 1 DefCol component "substring(bugs.component, 1, 8)" Comp bugs.component DefCol product "substring(bugs.product, 1, 8)" Product bugs.product DefCol version "substring(bugs.version, 1, 5)" Vers bugs.version DefCol os "substring(bugs.op_sys, 1, 4)" OS bugs.op_sys DefCol status_summary "bugs.status_summary" Status_Summary {} 1 if {[info exists COOKIE(COLUMNLIST)]} { set collist $COOKIE(COLUMNLIST) } else { set collist $default_column_list } set dotweak [info exists FORM(tweak)] if {$dotweak} { confirm_login } puts "Content-type: text/plain\n" set query " select bugs.bug_id" foreach c $collist { append query ", \t$key($c)" } if {$dotweak} { append query ", bugs.product, bugs.bug_status" } append query " from bugs, profiles assign, profiles report, versions projector where bugs.assigned_to = assign.userid and bugs.reporter = report.userid and bugs.product = projector.program and bugs.version = projector.value " if {[info exists FORM(sql)]} { append query "and (\n[join [url_decode $FORM(sql)] { }]\n)" } else { set legal_fields { bug_id product version rep_platform op_sys bug_status resolution priority bug_severity assigned_to reporter bug_file_loc short_desc component status_summary resolved_ts verified_ts} foreach field [array names FORM] { if { [ lsearch $legal_fields $field ] != -1 && ![cequal $FORM($field) ""]} { qadd "\tand (\n" set or "" if { $field == "assigned_to" || $field == "reporter" || $field == "qa_assigned_to"} { foreach p [split $FORM($field) ","] { qadd "\t\t${or}bugs.$field = [DBname_to_id $p]\n" set or "or " } } elseif { $field == "resolved_ts"} { if {! [cequal $FORM(resolved_ts_2) ""]} { qadd "\t\tbugs.resolved_ts between \n\t\t\tTO_DATE('$FORM($field)','DD-MON-YY') and\n \t\t\tTO_DATE('$FORM(resolved_ts_2)', 'DD-MON-YY')\n" } else { qadd "\t\tTO_CHAR (bugs.resolved_ts,'DD-MON-YY') = '[string toupper $FORM($field)]'\n" } } elseif { $field == "verified_ts"} { if {! [cequal $FORM(verified_ts_2) ""]} { qadd "\t\tbugs.verified_ts between \n\t\t\tTO_DATE('$FORM($field)','DD-MON-YY') and\n \t\t\tTO_DATE('$FORM(verified_ts_2)', 'DD-MON-YY')\n" } else { qadd "\t\tTO_CHAR (bugs.verified_ts,'DD-MON-YY') = '[string toupper $FORM($field)]'\n" } } else { foreach v $MFORM($field) { if {[cequal $v "(empty)"]} { qadd "\t\t${or}bugs.$field is null\n" } else { qadd "\t\t${or}bugs.$field = '$v'\n" } set or "or " } } qadd "\t)\n" } } if {[lookup FORM changedin] != ""} { qadd "and to_days(now()) - to_days(bugs.delta_ts) <= $FORM(changedin) " } } if {[info exists FORM(order)]} { qadd "order by " switch -glob $FORM(order) { *.* {} *Number* { set FORM(order) bugs.bug_id } *Import* { set FORM(order) bugs.priority } *Assign* { set FORM(order) "assign.login_name, bugs.bug_status, priorities.rank, bugs.bug_id" } default { set FORM(order) "bugs.bug_status, priorities.rank, assign.login_name, bugs.bug_id" } } if {[cequal [cindex $FORM(order) 0] "\{"]} { # I don't know why this happens, but... set FORM(order) [lindex $FORM(order) 0] } qadd $FORM(order) } puts "Please stand by ..." if {[info exists FORM(debug)]} { puts $query } flush stdout set child 0 if {[info exists FORM(keepalive)]} { set child [fork] if {$child == 0} { while 1 { puts "Still waiting ..." flush stdout sleep 10 } puts "Child process died, what's up?" flush stdout exit 0 } } SendSQL $query set count 0 set bugl "" proc pnl { str } { global bugl append bugl "$str" } regsub -all {[&?]order=[^&]*} $buffer {} fields regsub -all {[&?]cmdtype=[^&]*} $fields {} fields if {[info exists FORM(order)]} { regsub -all { } ", $FORM(order)" "%20" oldorder } else { set oldorder "" } if {$dotweak} { pnl "

" } set tablestart "

ID" foreach c $collist { if {$needquote($c)} { append tablestart "	" } else { append tablestart "	" } if {[info exists sortkey($c)]} { append tablestart "$title($c)" } else { append tablestart $title($c) } } append tablestart "\n" set dotweak [info exists FORM(tweak)] set p_true 1 while { $p_true } { set result [FetchSQLData] set p_true [MoreSQLData] if { $result != "" } { set bug_id [lvarpop result] if {![info exists seen($bug_id)]} { set seen($bug_id) 1 incr count if {($count % 200) == 0} { # Too big tables take too much browser memory... pnl "

$tablestart" } if {[info exists buglist]} { append buglist ":$bug_id" } else { set buglist $bug_id } pnl "" if {$dotweak} { pnl "" } pnl "" pnl "$bug_id " foreach c $collist { set value [lvarpop result] set nowrap {} #-- This cursor is used to pick the login_name to be # displayed on the query list as the field value may or # maynot have vales associated to it if { $c == "qa_assigned_to"} { set dml_cur [ oraopen $lhandle ] orasql $dml_cur "select login_name from profiles where userid = $value" set cur_resultset [orafetch $dml_cur] if {$cur_resultset != ""} { set value $cur_resultset set nowrap {nowrap} } else { set value "" } oraclose $dml_cur } if {$needquote($c)} { set value [html_quote $value] } else { set value "$value" } pnl "$value" } if {$dotweak} { set value [lvarpop result] set prodarray($value) 1 set value [lvarpop result] set statusarray($value) 1 } pnl "\n" } } } if {$child != 0} { kill $child } puts "" puts "--ThisRandomString" set toolong 0 puts "Content-type: text/html" if { [info exists buglist] } { if {[clength $buglist] < 4000} { puts "Set-Cookie: BUGLIST=$buglist\n" } else { puts "Set-Cookie: BUGLIST=\n" set toolong 1 } } else { puts "" } set env(TZ) PST8PDT PutHeader "Bug List" "Bug List" puts -nonewline "

MOZILLA BUGS

[fmtclock [getclock ]]" if {[info exists FORM(debug)]} { puts "

$query

" } if {$toolong} { puts "

This list is too long for bugzilla's little mind; the" puts "Next/Prev/First/Last buttons won't appear.

" } set cdata [ split [read_file -nonewline "comments"] "\n" ] random seed puts {

} puts [lindex $cdata [random [llength $cdata]]] puts "

$tablestart" puts $bugl puts "" switch $count { 0 { puts "Zarro Boogs found." } 1 { puts "One bug found." } default { puts "$count bugs found." } } if {$dotweak} { GetVersionTable puts " " set resolution_popup [make_options $legal_resolution_no_dup FIXED] GetVersionTable set prod_list [array names prodarray] set list $prod_list set legal_target_versions $versions([lvarpop list]) foreach p $list { set legal_target_versions [intersect $legal_target_versions \ $versions($p)] } set version_popup [make_options \ [concat "-blank-" $legal_target_versions] \ $dontchange] set platform_popup [make_options $legal_platform $dontchange] set priority_popup [make_options $legal_priority $dontchange] set sev_popup [make_options $legal_severity $dontchange] if {[llength $prod_list] == 1} { set prod_list [lindex $prod_list 0 ] set legal_component [linsert $components($prod_list) 0 { }] } else { set legal_component { } } set component_popup [make_options $legal_component $dontchange] set product_popup [make_options $legal_product $dontchange] puts "

Product:		Version:
Platform:		Priority:
Component:		Severity:

Additional Comments:

" # knum is which knob number we're generating, in javascript terms. set knum 0 puts " Do nothing else
" incr knum puts " Accept bugs (change status to ASSIGNED)
" incr knum if {![info exists statusarray(CLOSED)] && \ ![info exists statusarray(VERIFIED)] && \ ![info exists statusarray(RESOLVED)]} { puts " Clear the resolution
" incr knum puts " Resolve bugs, changing resolution to
" incr knum } if {![info exists statusarray(NEW)] && \ ![info exists statusarray(ASSIGNED)] && \ ![info exists statusarray(REOPENED)]} { puts " Reopen bugs
" incr knum } if {[llength [array names statusarray]] == 1} { if {[info exists statusarray(RESOLVED)]} { puts " Mark bugs as VERIFIED
" incr knum } if {[info exists statusarray(VERIFIED)]} { puts " Mark bugs as CLOSED
" incr knum } } puts " Reassign bugs to
" incr knum puts " Reassign bugs to owner of selected component
" incr knum puts "

To make changes to a bunch of bugs at once:

Put check boxes next to the bugs you want to change.

Adjust above form elements. (It's always a good idea to add some comment explaining what you're doing.)

Click the below \"Commit\" button.

" } if {$count > 0} { puts "" if {!$dotweak && $count > 1} { puts "Make changes to several of these bugs at once." } } puts "--ThisRandomString--" flush stdout # # Below is second part of hideous "if catch" stuff from above. # # # # }]} { # exec /usr/lib/sendmail -t << "To: terry # # # $query # # $errorInfo # " # }