From 4727e6c09f88e63f02e6c8f359862d0c0942ed36 Mon Sep 17 00:00:00 2001 From: "terry%netscape.com" <> Date: Wed, 16 Sep 1998 04:49:23 +0000 Subject: Everything has been ported to now run under Perl. --- globals.pl | 495 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 495 insertions(+) create mode 100644 globals.pl (limited to 'globals.pl') 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 + +# 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 $name is not a valid username. Please hit\n"; + print "the Back 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 +# ,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; -- cgit v1.2.3-24-g4f1b