Get rid of .tcl files; we're a perl app now.

1 files changed, 0 insertions, 454 deletions

diff --git a/globals.tcl b/globals.tcl
deleted file mode 100644
index f28ea431a..000000000
--- a/globals.tcl
+++ /dev/null
@@ -1,454 +0,0 @@
-# -*- 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 <terry@mozilla.org>
-
-# Contains some global variables and routines used throughout bugzilla.
-
-set maintainer "<a href=mailto:terry@netscape.com>terry@netscape.com</a>"
-
-if { ! [info exists oradbname] } {
-  set oradbname "SCOPPROD"
-}
-
-set dontchange "--do_not_change--"
-set chooseone "--Choose_one:--"
-
-set tmp_dir ""
-proc TmpName { tail } {
-  global tmp_dir
-  if { $tmp_dir == "" } {
-    set tmp_dir "/var/tmp/bugzilla"
-    if {! [file isdirectory $tmp_dir]} {
-      mkdir $tmp_dir
-    }
-  }
-  return "$tmp_dir/$tail"
-}
-
-proc ConnectToDatabase {} {
-    global mysqlhandle
-    if {![info exists mysqlhandle]} {
-        set mysqlhandle [mysqlconnect]
-        mysqluse $mysqlhandle "bugs"
-    }
-}
-
-
-proc SendSQL { str } {
-# puts $str
-    global mysqlhandle errorInfo
-    if {[catch {mysqlsel $mysqlhandle $str} errmsg]} {
-        puts $str
-        error "$errmsg - $str" $errorInfo
-    }
-    return 0
-}
-
-proc MoreSQLData {} {
-    global mysqlhandle
-    set result [mysqlresult $mysqlhandle "rows?"]
-    if {![cequal $result ""]} {
-        if {$result > 0} {
-            return 1
-        }
-    }
-    return 0
-}
-
-proc FetchSQLData {} {
-    global mysqlhandle
-    return [mysqlnext $mysqlhandle]
-}
-
-proc Disconnect {} {
-    global mysqlhandle
-    mysqlclose $mysqlhandle
-    unset mysqlhandle
-}
-
-
-set legal_opsys { "Windows 3.1" "Windows 95" "Windows NT" "System 7" "System 7.5"
-               "7.1.6" "AIX" "BSDI" "HP-UX" "IRIX" "Linux" "OSF/1" "Solaris" "SunOS"
-               "other" }
-
-
-set default_column_list {severity priority platform owner status resolution summary}
-
-set env(TZ) PST8PDT
-
-proc AppendComment {bugid who comment} {
-    regsub -all "\r\n" $comment "\n" comment
-    if {[cequal $comment "\n"] || [clength $comment] == 0} {
-        return
-    }
-    SendSQL "select long_desc from bugs where bug_id = $bugid"
-    set desc [lindex [FetchSQLData] 0]
-    append desc "\n\n------- Additional Comments From $who  [fmtclock [getclock] "%D %H:%M"] -------\n"
-    append desc $comment
-    SendSQL "update bugs set long_desc='[SqlQuote $desc]' where bug_id=$bugid"
-}
-
-proc SortIgnoringCase {a b} {
-    return [string compare [string tolower $a] [string tolower $b]]
-}
-
-
-proc make_popup { name src default listtype {onchange {}}} {
-    set popup "<SELECT NAME=$name"
-    if {$listtype > 0} {
-        append popup " SIZE=5"
-        if {$listtype == 2} {
-            append popup " MULTIPLE"
-        }
-    }
-    if {$onchange != ""} {
-        append popup " onchange=$onchange"
-    }
-    append popup ">"
-    append popup [make_options $src $default [expr {$listtype == 2 && $default != ""}]]
-    append popup "</SELECT>"
-    return $popup
-}
-
-proc Product_element { prod {onchange {}} } {
-    global versions
-    return [make_popup product [lsort [array names versions]] $prod 1 \
-                $onchange]
-}
-
-proc Component_element { comp prod {onchange {}} } {
-    global components
-    if {![info exists components($prod)]} {
-        set componentlist {}
-    } else {
-        set componentlist $components($prod)
-    }
-        
-    if {![cequal $comp ""] && [lsearch $componentlist $comp] >= 0} {
-        set defcomponent $comp
-    } else {
-        set defcomponent [lindex $componentlist 0]
-    }
-    return [make_popup component $componentlist $defcomponent 1 ""]
-}
-
-proc Version_element { vers prod {onchange {}} } {
-  global versions
-  if {![info exists versions($prod)]} {
-    set versionlist {}
-  } else {
-    set versionlist $versions($prod)
-  }
-
-  set defversion [lindex $versionlist 0]
-
-  if {[lsearch $versionlist $vers] >= 0} {
-    set defversion $vers
-  }
-  return [make_popup version $versionlist $defversion 1 $onchange]
-}
-
-proc GenerateVersionTable {} {
-    ConnectToDatabase
-    SendSQL "select value, program from versions order by value"
-    while { [ MoreSQLData ] } {
-        set line [FetchSQLData]
-        if {$line != ""} {
-            set v [lindex $line 0]
-            set p1 [lindex $line 1]
-            lappend versions($p1) $v
-            set varray($v) 1
-            set parray($p1) 1
-        }
-    }
-
-    SendSQL "select value, program from components"
-    while { [ MoreSQLData ] } {
-        set line [FetchSQLData]
-        if {$line != ""} {
-            lassign $line c p
-            lappend components($p) $c
-            set carray($c) 1
-            set parray($p) 1
-        }
-    }
-
-    LearnAboutColumns bugs cols
-    set log_columns $cols(-list-)
-    foreach i {bug_id creation_ts delta_ts long_desc} {
-        set w [lsearch $log_columns $i]
-        if {$w >= 0} {
-            set log_columns [lreplace $log_columns $w $w]
-        }
-    }
-    set legal_priority [SplitEnumType $cols(priority,type)]
-    set legal_severity [SplitEnumType $cols(bug_severity,type)]
-    set legal_platform [SplitEnumType $cols(rep_platform,type)]
-    set legal_bug_status [SplitEnumType $cols(bug_status,type)]
-    set legal_resolution [SplitEnumType $cols(resolution,type)]
-    set legal_resolution_no_dup $legal_resolution
-    set w [lsearch $legal_resolution_no_dup "DUPLICATE"]
-    if {$w >= 0} {
-        set legal_resolution_no_dup [lreplace $legal_resolution_no_dup $w $w]
-    }
-
-    set list [lsort -command SortIgnoringCase [array names versions]]
-    
-    set tmpname "versioncache.[id process]"
-
-    set fid [open $tmpname "w"]
-    puts $fid [list set log_columns $log_columns]
-    foreach i $list {
-        puts $fid [list set versions($i) $versions($i)]
-        if {![info exists components($i)]} {
-            set components($i) {}
-        }
-    }
-
-    puts $fid [list set legal_versions [lsort -command SortIgnoringCase \
-                                            [array names varray]]]
-    foreach i [lsort -command SortIgnoringCase [array names components]] {
-        puts $fid [list set components($i) $components($i)]
-    }
-    puts $fid [list set legal_components [lsort -command SortIgnoringCase \
-                                              [array names carray]]]
-    puts $fid [list set legal_product $list]
-    puts $fid [list set legal_priority $legal_priority]
-    puts $fid [list set legal_severity $legal_severity]
-    puts $fid [list set legal_platform $legal_platform]
-    puts $fid [list set legal_bug_status $legal_bug_status]
-    puts $fid [list set legal_resolution $legal_resolution]
-    puts $fid [list set legal_resolution_no_dup $legal_resolution_no_dup]
-    close $fid
-    frename $tmpname "versioncache"
-    catch {chmod 0666 "versioncache"}
-}
-
-# This proc must be called before using legal_product or the versions array.
-
-proc GetVersionTable {} {
-    global versions
-    set mtime 0
-    catch {set mtime [file mtime versioncache]}
-    if {[getclock] - $mtime > 3600} {
-        GenerateVersionTable
-    }
-    uplevel #0 {source versioncache}
-    if {![info exists versions]} {
-        GenerateVersionTable
-        uplevel #0 {source versioncache}
-        if {![info exists versions]} {
-            error "Can't generate version info; tell terry."
-        }
-    }
-}
-
-
-
-proc GeneratePersonInput { field required def_value {extraJavaScript {}} } {
-    if {![cequal $extraJavaScript ""]} {
-        set $extraJavaScript "onChange=\" $extraJavaScript \""
-    }
-    return "<INPUT NAME=\"$field\" SIZE=32 $extraJavaScript VALUE=\"$def_value\">"
-}
-
-proc GeneratePeopleInput { field def_value } {
-  return "<INPUT NAME=\"$field\" SIZE=45 VALUE=\"$def_value\">"
-}
-
-
-
-set cachedNameArray() ""
-
-proc InsertNewUser {username} {
-    random seed
-    set pwd ""
-    loop i 0 8 {
-        append pwd [cindex "abcdefghijklmnopqrstuvwxyz" [random 26]]
-    }
-    SendSQL "insert into profiles (login_name, password, cryptpassword) values ('[SqlQuote $username]', '$pwd', encrypt('$pwd'))"
-    return $pwd
-}
-
-
-proc DBID_to_name { id } {
-    global cachedNameArray
-
-    if {![info exists cachedNameArray($id)]} {
-
-        SendSQL "select login_name from profiles where userid = $id"
-        set r [FetchSQLData]
-        if {$r == ""} { set r "__UNKNOWN__" }
-        set cachedNameArray($id) $r
-    }
-    return $cachedNameArray($id)
-}
-
-proc DBname_to_id { name } {
-    SendSQL "select userid from profiles where login_name = '[SqlQuote $name]'"
-    set r [FetchSQLData]
-    if {[cequal $r ""]} {
-        return 0
-    }
-    return $r
-}
-
-proc DBNameToIdAndCheck {name {forceok 0}} {
-    set result [DBname_to_id $name]
-    if {$result > 0} {
-        return $result
-    }
-    if {$forceok} {
-        InsertNewUser $name
-        set result [DBname_to_id $name]
-        if {$result > 0} {
-            return $result
-        }
-        puts "Yikes; couldn't create user $name.  Please report problem to"
-        puts "$maintainer."
-    } else {
-        puts "The name <TT>$name</TT> is not a valid username.  Please hit the"
-        puts "<B>Back</B> button and try again."
-    }
-    exit 0
-}
-
-proc GetLongDescription { id } {
-    SendSQL "select long_desc from bugs where bug_id = $id"
-    return [lindex [FetchSQLData] 0]
-}
-
-proc ShowCcList {num} {
-    set cclist ""
-    set comma ""
-    SendSQL "select who from cc where bug_id = $num"
-    set ccids ""
-    while {[MoreSQLData]} {
-        lappend ccids [lindex [FetchSQLData] 0]
-    }
-    set result ""
-    foreach i $ccids {
-        lappend result [DBID_to_name $i]
-    }
-
-    return [join $result ","]
-}
-
-proc make_options_new { src default {isregexp 0} } {
-    set last "" ; set popup "" ; set found 0
-    foreach item $src {
-        if { $item == "-blank-" } { set item "" } {
-            if {$isregexp ? [regexp $default $item] : [cequal $default $item]} {
-                append popup "<OPTION SELECTED VALUE=\"$item\">$item"
-                set found 1
-            } else {
-                append popup "<OPTION VALUE=\"$item\">$item"
-            }
-        }
-    }
-    if {!$found && $default != ""} {
-        append popup "<OPTION SELECTED>$default"
-    }
-    return $popup
-}
-
-
-proc Shell {} {
-    ConnectToDatabase
-    while (1) {
-        puts -nonewline "> "
-        if {[gets stdin line] < 0} {
-            break
-        }
-        if {[catch {SendSQL $line} errorinfo]} {
-            puts "Error -- $errorinfo"
-        } else {
-            while {[MoreSQLData]} {
-                puts [FetchSQLData]
-            }
-        }
-    }
-}
-
-
-
-
-# Fills in the given array with info about the columns.  The array gets
-# the following entries:
-#   -list-  the list of column names
-#   <name>,type  the type for the given name
-
-proc LearnAboutColumns {table arrayname} {
-    upvar $arrayname a
-    catch (unset a)
-    SendSQL "show columns from $table"
-    set list {}
-    while {[MoreSQLData]} {
-        lassign [FetchSQLData] name type
-        set a($name,type) $type
-        lappend list $name
-    }
-    set a(-list-) $list
-}
-
-# If the above returned a enum type, take that type and parse it into the
-# list of values.  Assumes that enums don't ever contain an apostrophe!
-
-proc SplitEnumType {str} {
-    set result {}
-    if {[regexp {^enum\((.*)\)$} $str junk guts]} {
-        append guts ","
-        while {[regexp {^'([^']*)',(.*)$} $guts junk first guts]} {
-            lappend result $first
-        }
-    }
-    return $result
-}
-
-
-proc SqlQuote {str} {
-    regsub -all "'" $str "''" str
-    # 
-    # This next line is quoting hell.  One level of quoting comes from
-    # the TCL interpreter, and another level comes from TCL's regular
-    # expression parser.  It really works out to "change every
-    # backslash to two backslashes".
-    regsub -all "\\\\" $str "\\\\\\\\" str
-
-    return $str
-}
-
-
-proc Param {value} {
-    global param
-    if {[info exists param($value)]} {
-        return $param($value)
-    }
-    # Um, maybe we haven't sourced in the params at all yet.
-    catch {uplevel \#0 source "params"}
-    if {[info exists param($value)]} {
-        return $param($value)
-    }
-    # Well, that didn't help.  Maybe it's a new param, and the user
-    # hasn't defined anything for it.  Try and load a default value
-    # for it.
-    uplevel #0 source "defparams.tcl"
-    WriteParams
-    return $param($value)
-}