Everything has been ported to now run under Perl.

1 files changed, 495 insertions, 0 deletions

diff --git a/globals.pl b/globals.pl
new file mode 100644
index 000000000..1a6990ac5
--- /dev/null
+++ b/globals.pl
@@ -0,0 +1,495 @@
+# -*- Mode: perl; 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.
+
+use diagnostics;
+use strict;
+use Mysql;
+
+use Date::Format;               # For time2str().
+
+$::dontchange = "--do_not_change--";
+$::chooseone = "--Choose_one:--";
+
+sub ConnectToDatabase {
+    if (!defined $::db) {
+	$::db = Mysql->Connect("localhost", "bugs", "bugs", "")
+            || die "Can't connect to database server.";
+    }
+}
+
+sub SendSQL {
+    my ($str) = (@_);
+    $::currentquery = $::db->query($str)
+	|| die "$str: $::db_errstr";
+}
+
+sub MoreSQLData {
+    if (defined @::fetchahead) {
+	return 1;
+    }
+    if (@::fetchahead = $::currentquery->fetchrow()) {
+	return 1;
+    }
+    return 0;
+}
+
+sub FetchSQLData {
+    if (defined @::fetchahead) {
+	my @result = @::fetchahead;
+	undef @::fetchahead;
+	return @result;
+    }
+    return $::currentquery->fetchrow();
+}
+
+
+sub FetchOneColumn {
+    my @row = FetchSQLData();
+    return $row[0];
+}
+
+    
+@::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");
+
+
+@::default_column_list = ("severity", "priority", "platform", "owner",
+                          "status", "resolution", "summary");
+
+sub AppendComment {
+    my ($bugid,$who,$comment) = (@_);
+    $comment =~ s/\r\n/\n/;     # Get rid of windows-style line endings.
+    if ($comment =~ /^\s*$/) {  # Nothin' but whitespace.
+        return;
+    }
+    SendSQL("select long_desc from bugs where bug_id = $bugid");
+    
+    my $desc = FetchOneColumn();
+    my $now = time2str("%D %H:%M", time());
+    $desc .= "\n\n------- Additional Comments From $who  $now -------\n";
+    $desc .= $comment;
+    SendSQL("update bugs set long_desc=" . SqlQuote($desc) .
+            " where bug_id=$bugid");
+}
+
+sub lsearch {
+    my ($list,$item) = (@_);
+    my $count = 0;
+    foreach my $i (@$list) {
+        if ($i eq $item) {
+            return $count;
+        }
+        $count++;
+    }
+    return -1;
+}
+
+sub Product_element {
+    my ($prod,$onchange) = (@_);
+    return make_popup("product", keys %::versions, $prod, 1, $onchange);
+}
+
+sub Component_element {
+    my ($comp,$prod,$onchange) = (@_);
+    my $componentlist;
+    if (! defined $::components{$prod}) {
+        $componentlist = [];
+    } else {
+        $componentlist = $::components{$prod};
+    }
+    my $defcomponent;
+    if ($comp ne "" && lsearch($componentlist, $comp) >= 0) {
+        $defcomponent = $comp;
+    } else {
+        $defcomponent = $componentlist->[0];
+    }
+    return make_popup("component", $componentlist, $defcomponent, 1, "");
+}
+
+sub Version_element {
+    my ($vers, $prod, $onchange) = (@_);
+    my $versionlist;
+    if (!defined $::versions{$prod}) {
+        $versionlist = [];
+    } else {
+        $versionlist = $::versions{$prod};
+    }
+    my $defversion = $versionlist->[0];
+    if (lsearch($versionlist,$vers) >= 0) {
+        $defversion = $vers;
+    }
+    return make_popup("version", $versionlist, $defversion, 1, $onchange);
+}
+        
+
+
+# Generate a string which, when later interpreted by the Perl compiler, will
+# be the same as the given string.
+
+sub PerlQuote {
+    my ($str) = (@_);
+    return SqlQuote($str);
+    
+# The below was my first attempt, but I think just using SqlQuote makes more 
+# sense...
+#     $result = "'";
+#     $length = length($str);
+#     for (my $i=0 ; $i<$length ; $i++) {
+#         my $c = substr($str, $i, 1);
+#         if ($c eq "'" || $c eq '\\') {
+#             $result .= '\\';
+#         }
+#         $result .= $c;
+#     }
+#     $result .= "'";
+#     return $result;
+}
+
+
+# Given the name of a global variable, generate Perl code that, if later
+# executed, would restore the variable to its current value.
+
+sub GenerateCode {
+    my ($name) = (@_);
+    my $result = $name . " = ";
+    if ($name =~ /^\$/) {
+        my $value = eval($name);
+        if (ref($value) eq "ARRAY") {
+            $result .= "[" . GenerateArrayCode($value) . "]";
+        } else {
+            $result .= PerlQuote(eval($name));
+        }
+    } elsif ($name =~ /^@/) {
+        my @value = eval($name);
+        $result .= "(" . GenerateArrayCode(\@value) . ")";
+    } elsif ($name =~ '%') {
+        $result = "";
+        foreach my $k (sort { uc($a) cmp uc($b)} eval("keys $name")) {
+            $result .= GenerateCode("\$" . substr($name, 1) .
+                                    "{'" . $k . "'}");
+        }
+        return $result;
+    } else {
+        die "Can't do $name -- unacceptable variable type.";
+    }
+    $result .= ";\n";
+    return $result;
+}
+
+sub GenerateArrayCode {
+    my ($ref) = (@_);
+    my @list;
+    foreach my $i (@$ref) {
+        push @list, PerlQuote($i);
+    }
+    return join(',', @list);
+}
+
+
+
+sub GenerateVersionTable {
+    ConnectToDatabase();
+    SendSQL("select value, program from versions order by value");
+    my @line;
+    my %varray;
+    my %carray;
+    while (@line = FetchSQLData()) {
+        my ($v,$p1) = (@line);
+        if (!defined $::versions{$p1}) {
+            $::versions{$p1} = [];
+        }
+        push @{$::versions{$p1}}, $v;
+        $varray{$v} = 1;
+    }
+    SendSQL("select value, program from components");
+    while (@line = FetchSQLData()) {
+        my ($c,$p) = (@line);
+        if (!defined $::components{$p}) {
+            $::components{$p} = [];
+        }
+        my $ref = $::components{$p};
+        push @$ref, $c;
+        $carray{$c} = 1;
+    }
+
+    my $cols = LearnAboutColumns("bugs");
+    
+    @::log_columns = @{$cols->{"-list-"}};
+    foreach my $i ("bug_id", "creation_ts", "delta_ts", "long_desc") {
+        my $w = lsearch(\@::log_columns, $i);
+        if ($w >= 0) {
+            splice(@::log_columns, $w, 1);
+        }
+    }
+
+    @::legal_priority = SplitEnumType($cols->{"priority,type"});
+    @::legal_severity = SplitEnumType($cols->{"bug_severity,type"});
+    @::legal_platform = SplitEnumType($cols->{"rep_platform,type"});
+    @::legal_bug_status = SplitEnumType($cols->{"bug_status,type"});
+    @::legal_resolution = SplitEnumType($cols->{"resolution,type"});
+    @::legal_resolution_no_dup = @::legal_resolution;
+    my $w = lsearch(\@::legal_resolution_no_dup, "DUPLICATE");
+    if ($w >= 0) {
+        splice(@::legal_resolution_no_dup, $w, 1);
+    }
+
+    my @list = sort { uc($a) cmp uc($b)} keys(%::versions);
+    @::legal_product = @list;
+    mkdir("data", 0777);
+    chmod 0777, "data";
+    my $tmpname = "data/versioncache.$$";
+    open(FID, ">$tmpname") || die "Can't create $tmpname";
+
+    print FID GenerateCode('@::log_columns');
+    print FID GenerateCode('%::versions');
+
+    foreach my $i (@list) {
+        if (!defined $::components{$i}) {
+            $::components{$i} = "";
+        }
+    }
+    @::legal_versions = sort {uc($a) cmp uc($b)} keys(%varray);
+    print FID GenerateCode('@::legal_versions');
+    print FID GenerateCode('%::components');
+    @::legal_components = sort {uc($a) cmp uc($b)} keys(%carray);
+    print FID GenerateCode('@::legal_components');
+    foreach my $i('product', 'priority', 'severity', 'platform',
+                  'bug_status', 'resolution', 'resolution_no_dup') {
+        print FID GenerateCode('@::legal_' . $i);
+    }
+
+    print FID "1;\n";
+    close FID;
+    rename $tmpname, "data/versioncache" || die "Can't rename $tmpname to versioncache";
+    chmod 0666, "data/versioncache";
+}
+
+
+
+# Returns the modification time of a file.
+
+sub ModTime {
+    my ($filename) = (@_);
+    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+        $atime,$mtime,$ctime,$blksize,$blocks)
+        = stat($filename);
+    return $mtime;
+}
+
+
+
+# This proc must be called before using legal_product or the versions array.
+
+sub GetVersionTable {
+    my $mtime = ModTime("data/versioncache");
+    if (!defined $mtime || $mtime eq "") {
+        $mtime = 0;
+    }
+    if (time() - $mtime > 3600) {
+        GenerateVersionTable();
+    }
+    require 'data/versioncache';
+    if (!defined %::versions) {
+        GenerateVersionTable();
+        do 'data/versioncache';
+
+        if (!defined %::versions) {
+            die "Can't generate version info; tell terry.";
+        }
+    }
+}
+
+
+sub InsertNewUser {
+    my ($username) = (@_);
+    my $password = "";
+    for (my $i=0 ; $i<8 ; $i++) {
+        $password .= substr("abcdefghijklmnopqrstuvwxyz", int(rand(26)), 1);
+    }
+    SendSQL("insert into profiles (login_name, password, cryptpassword) values (@{[SqlQuote($username)]}, '$password', encrypt('$password')");
+    return $password;
+}
+
+
+sub DBID_to_name {
+    my ($id) = (@_);
+    if (!defined $::cachedNameArray{$id}) {
+        SendSQL("select login_name from profiles where userid = $id");
+        my $r = FetchOneColumn();
+        if ($r eq "") {
+            $r = "__UNKNOWN__";
+        }
+        $::cachedNameArray{$id} = $r;
+    }
+    return $::cachedNameArray{$id};
+}
+
+sub DBname_to_id {
+    my ($name) = (@_);
+    SendSQL("select userid from profiles where login_name = @{[SqlQuote($name)]}");
+    my $r = FetchOneColumn();
+    if ($r eq "") {
+        return 0;
+    }
+    return $r;
+}
+
+
+sub DBNameToIdAndCheck {
+    my ($name, $forceok) = (@_);
+    my $result = DBname_to_id($name);
+    if ($result > 0) {
+        return $result;
+    }
+    if ($forceok) {
+        InsertNewUser($name);
+        $result = DBname_to_id($name);
+        if ($result > 0) {
+            return $result;
+        }
+        print "Yikes; couldn't create user $name.  Please report problem to " .
+            Param("maintainer") ."\n";
+    } else {
+        print "The name <TT>$name</TT> is not a valid username.  Please hit\n";
+        print "the <B>Back</B> button and try again.\n";
+    }
+    exit(0);
+}
+
+sub GetLongDescription {
+    my ($id) = (@_);
+    SendSQL("select long_desc from bugs where bug_id = $id");
+    return FetchOneColumn();
+}
+
+
+sub ShowCcList {
+    my ($num) = (@_);
+    my @ccids;
+    my @row;
+    SendSQL("select who from cc where bug_id = $num");
+    while (@row = FetchSQLData()) {
+        push(@ccids, $row[0]);
+    }
+    my @result = ();
+    foreach my $i (@ccids) {
+        push @result, DBID_to_name($i);
+    }
+
+    return join(',', @result);
+}
+
+
+
+# Fills in a hashtable with info about the columns for the given table in the
+# database.  The hashtable has the following entries:
+#   -list-  the list of column names
+#   <name>,type  the type for the given name
+
+sub LearnAboutColumns {
+    my ($table) = (@_);
+    my %a;
+    SendSQL("show columns from $table");
+    my @list = ();
+    my @row;
+    while (@row = FetchSQLData()) {
+        my ($name,$type) = (@row);
+        $a{"$name,type"} = $type;
+        push @list, $name;
+    }
+    $a{"-list-"} = \@list;
+    return \%a;
+}
+
+
+
+# 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!
+
+sub SplitEnumType {
+    my ($str) = (@_);
+    my @result = ();
+    if ($str =~ /^enum\((.*)\)$/) {
+        my $guts = $1 . ",";
+        while ($guts =~ /^\'([^\']*)\',(.*)$/) {
+            push @result, $1;
+            $guts = $2;
+	}
+    }
+    return @result;
+}
+
+
+# This routine is largely copied from Mysql.pm.
+
+sub SqlQuote {
+    my ($str) = (@_);
+    $str =~ s/([\\\'])/\\$1/g;
+    $str =~ s/\0/\\0/g;
+    return "'$str'";
+}
+
+
+
+sub Param {
+    my ($value) = (@_);
+    if (defined $::param{$value}) {
+        return $::param{$value};
+    }
+    # Um, maybe we haven't sourced in the params at all yet.
+    if (stat("data/params")) {
+        require "data/params";
+    }
+    if (defined $::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.
+    require "defparams.pl";
+    WriteParams();
+    if (defined $::param{$value}) {
+        return $::param{$value};
+    }
+    # We're pimped.
+    die "Can't find param named $value";
+}
+
+    
+sub PerformSubsts {
+    my ($str, $substs) = (@_);
+    $str =~ s/%([a-z]*)%/(defined $substs->{$1} ? $substs->{$1} : Param($1))/eg;
+    return $str;
+}
+
+
+# Trim whitespace from front and back.
+
+sub trim {
+    ($_) = (@_);
+    s/^\s*//g;
+    s/\s*$//g;
+    return $_;
+}
+
+1;