#!/usr/local/bin/perl5
$| = 1;
# libgnats.pl - a Perl interface to the GNATS bug tracking system

### Modification log:
# 2/1/95  Dan Kegel  Split off from wwwgnats.pl
# 3/1/95  Dan Kegel  Added pr_addr function
### End Modifcation log

#### Configuration begins here
# Gnats
$GNATS_BIN  = "/usr/local/bin";
$GNATS_LIB  = "/usr/local/lib";
$GNATS_ROOT = "/gnats/share/gnats/gnats-db";
$GNATS_ADM  = "$GNATS_ROOT/gnats-adm";
$PR_EDIT    = "$GNATS_LIB/gnats/pr-edit";
$PR_ADDR    = "$GNATS_LIB/gnats/pr-addr";
$GNATS_VER   = "3.100";
$GNATS_ADDR  = "bugs\@nnnn.nnn.nn";
$GNATS_DOC   = "http://consult.cern.ch/writeups/gnats/gnats.html";

### Configuration ends here

#################### Array definitions
# Query-pr's -i option outputs the following fields numerically.
# Define arrays to map numbers to name.

# Standard GNATS arrays
@nSeverity = ("", "critical", "serious", "non-critical");
@nPriority = ("", "high", "medium", "low");
@nState    = ("", "open", "assigned", "suspended", "feedback", "closed");
@nClass    = ("", "sw-bug", "doc-bug", "support", "change-request", "mistaken", "duplicate", "unscheduled", "scheduled");

# Single-line field names
@fieldnames_single = (
		"Submitter-Id",
		"Originator",
		"Organization",
		"Confidential",
		"Synopsis",
		"Severity",
		"Priority",
		"Category",
		"Class",
		"Release",
		"State",
		"Responsible",
                "Start-Date",
                "End-Date",
		"Arrival-Date",
	    );
%fieldnames_single = (
		"Submitter-Id", 1,
		"Originator", 1,
		"Organization", 1,	# Doc is ambiguous about whether Org is multi-text 
		"Confidential", 1,
		"Synopsis", 1,
		"Severity", 1,
		"Priority", 1,
		"Category", 1,
		"Class", 1,
		"Release", 1,
                "Start-Date", 1,
                "End-Date", 1,
		"State", 2,		# The fields with "2" are not submitted in SPRs.
		"Responsible", 2,
		"Arrival-Date", 2,
	    );

# Multiple-line field names
@fieldnames_multi = (
		"Environment",
		"Description",
		"How-To-Repeat",
		"Response",
		"Audit-Trail",
		"Unformatted",
	    );
%fieldnames_multi = (
		"Environment", 1,
		"Description", 1,
		"How-To-Repeat", 1,
		"Response", 1,
		"Audit-Trail", 1,
		"Unformatted", 1,
	    );

#audit-trail had a 2 originally! Eva

&read_category;
&read_responsible;


sub Greater_to_Other {
#changes all appearences of ">" to "!" in the input string

 while ($_[0] =~ s/>/&gt/) {;}

}

sub Other_to_Greater {
#changes all appearances of "!" to ">" in the input string
    while ($_[0] =~ s/&gt/>/) {;}
}



# Translates '+' to ' ' and '%##' to 'chr(0x##)'
sub cgi_trans
{
    local($str) = $_[0];

    $str =~ s/\+/ /g;
    $str =~ s/%([\dA-Fa-f][\dA-Fa-f])/sprintf("%c",hex($1))/eg;
    return $str;
}


sub format_sixty {

# Input: a multitext record
# It takes a multitext record and breaks it into 60-column lines
# but it preserves the paragraphs already done

  
    @lineas=split(/\n/,$_[0]);
    $resul="";
    foreach $frase (@lineas) {
	$auxi=0;
	$contador=0;
	while (length($frase)>80) {

	    $auxi=$frase;

	    foreach $i (0..(length($frase)-81)) {
		chop($auxi);
	    }
	    $resul.=$auxi;
	    $resul.="\n";
	    $inicio=60;
	    $tam=length($frase)-80; 
	    $bas=substr($frase,$inicio,$tam);	
	    $frase=$bas;
	    $contador=$contador+1;
	}
	if (length($frase)>0) {
	 $resul.=$frase;
	 $resul.="\n";
         }
   
}
    
$_[0]=$resul;

}

#end of format_eighty


# Convert to lower case
sub tolower
{
    local($str) = $_[0];

    $str =~ tr/A-Z/a-z/;
    return $str;
}

# Parse a problem report into fields.
# Call with problem report in an array.
# Fills the associative array %fieldvalues with the results.
sub parse_pr 
{
    local($hdr,$arg,$hdr_nogt);
    local($hdr_multi) = "envelope";  # File is email envelope until first gnats fieldname.
    undef %fieldvalues;
    #print "parse_pr: <pre>\n";
    foreach (@_) {
	# skip non-headers
	if (!/^([>\w\-]+):\s*(.*)\s*$/) {
	    if ($hdr_multi ne "") {
		$fieldvalues{$hdr_multi} .= $_;
		#&Greater_to_Other($fieldvalues{$hdr_multi});
		#print "Appending to multi-line header $hdr_multi: $_\n";
	    }
	    next;
	}

	$hdr = $1;
	$arg = $2;
	$hdr_nogt = "*not a valid field name*";
	if ($hdr =~ /^>(.*)$/) {
	    $hdr_nogt = $1;
	}
	#print "<pre>\n";
	#print "hdr = $hdr\t";
	#print "arg = $arg\n";
	#print "</pre>\n";
	if ($fieldnames_single{$hdr_nogt}) {
	    $hdr_multi = "";
	    $fieldvalues{$hdr_nogt} = $arg;
	    #&Greater_to_Other($fieldvalues{$hdr_nogt});
	    #print "storing, hdr = $hdr_nogt, arg = $arg\n";
	} elsif ($fieldnames_multi{$hdr_nogt}) {
	    $hdr_multi = $hdr_nogt;
	    $fieldvalues{$hdr_nogt} = "";
	    #&Greater_to_Other($fieldvalues{$hdr_nogt});
	    #print "Starting multi-line header $hdr_multi\n";
	} elsif ($hdr_multi ne "") {
	    $fieldvalues{$hdr_multi} .= $_;
	    #&Greater_to_Other($fieldvalues{$hdr_multi});
	    #print "Appending to multi-line header $hdr_multi: $_\n";
	}
	if ($hdr eq "Reply-To" || $hdr eq "From") {
	    # Grab a few fields out of the envelope as it flies by
	    $arg = &tolower($arg);
	    #  Delete everything inside parenthesis and outside <>'s, inclusive.
	    $arg =~ s/\(.*\)//;
	    $arg =~ s/.*<(.*)>.*/$1/;
	    $arg =~ s/^\s+//;
	    $arg =~ s/\s+$//;
	    print "error: internal whitespace in Reply-to: or From: header!" if ($arg =~ /\s/);
	    $fieldvalues{$hdr} = $arg;
	    #&Greater_to_Other($fieldvalues{$hdr});
	    #print "storing, hdr = $hdr, arg = $arg\n";
	}
    }

}

# Generate a flat pr file from the %fieldvalues array.
# If argument is "send", don't include fields which are not generated by send-pr.
# Usage: $prtext = &unparse_pr("");
sub unparse_pr
{
    local($send) = $_[0];
    local($prtext, $tmp);
    $prtext = $fieldvalues{"envelope"};
    foreach (@fieldnames_single) {
	#&Other_to_Greater($_);
	next if ($send eq "send" && $fieldnames_single{$_} > 1);
	$tmp = ">$_:";
	$tmp .= " " x (17-length($tmp));
	$prtext .= $tmp . $fieldvalues{$_} . "\n";
    }
    foreach (@fieldnames_multi) {
	#&Other_to_Greater($_);
	next if ($send eq "send" && $fieldnames_multi{$_} > 1);
	$prtext .= ">$_:\n" . $fieldvalues{$_};
    }
    #if (!open(RECONSTRUCTED, "|sort > /tmp/recon")) {
	#print "Unable to create /tmp/recon\n";
    #}
    #print RECONSTRUCTED $prtext;
    #close(RECONSTRUCTED);
    #system("sort $fullpr | diff /tmp/recon - > /tmp/pr.diff");

    return $prtext;
}

#################### Read in GNATS data
# Read in possible responsible parties
sub read_responsible {
    #  nametag : fullname : e-mail address
    #  db:Dave Benson:david_benson@ccmail.adventure.com
    # Note: in our installation, the nametags are also valid local
    # e-mail aliases.
    open(RESPON, "$GNATS_ADM/responsible".$domain) ||
	die "Couln't get responsible file\n";
    local($nametag, $fullname, $email);
    while (<RESPON>) {
	if (!/^\s*#|^\s*\n$/) {
	    ($nametag, $fullname, $email) = split(/:/);
	    push(@nResponsible, $nametag);
	    # Make a table which maps from fullname to nametag.
	    # This is used when we want to look up bugs by person
	    # without regards to whether the person is the originator
	    # or the responsible party.
	    # In our system, we use short nametags in the responsible field,
	    # and fullname in the originator field.
	    # So I hope the fullname is entered identically in both
	    # the resposible file and the originator file.
	    $fullname = &tolower($fullname);
	    $nametag = &tolower($nametag);
	    $fullname2nametag{$fullname} = $nametag;
	    # Make a table which maps from nametag to fullname.
	    # This is used when counting up bugs according to who they are waiting on.
	    $nametag2fullname{$nametag} = $fullname;
	}
    }
    close(RESPON);
    @nResponsible = sort(@nResponsible);
    unshift(@nResponsible, "");
}

# Read in possible categories
sub read_category {
    # category tag : category name : responsible : other-interested-people
    # ace-bitmap:Accomplish Bitmap Dwg:sr:dank
    open(CATEG, "$GNATS_ADM/categories".$domain) ||
	die "Couln't get categories file\n";
    while (<CATEG>) {
	if (!/^\s*#|^\s*\n$/) {
	    ($x, $dummy) = split(/:/);
	    push(@nCategory, $x);
	}
    }
    close(CATEG);
    @nCategory = sort(@nCategory);
    unshift(@nCategory, "");  # needed for 'any'
}




# Given the number of the pr, find $semipr (category/number) and $fullpr (path to datafile)
sub pr_get_path
{
    local($pr) = $_[0];
    # Read in the path of the specified pr from the GNATS index
        # Next line is taken from script edit-pr
    open(PR, "/bin/grep \"/$pr:\" $GNATS_ADM/index | /usr/bin/awk -F: '{print \$1}' - |") || die "Error while browsing through GNATS index";
    chop($semipr = <PR>);
    $fullpr="$GNATS_ROOT/" . $semipr;
    close(PR);
}

# Lock the given pr.  Must specify category/number.
# Usage: $errmsg = &pr_lock($semipr,$who_is_locking);
# Returns "" on success, error message on failure.
sub pr_lock
{
    local($semipr) = $_[0];
    local($locker) = $_[1];
    # Lock the PR
    # This is actually ineffective since the lock must occur in
    # edit_pr(), but it does check against changes made through edit-pr
    #print "locking pr...\n";

    if (!open(PREDIT, "$PR_EDIT --lock=\'$locker\' $semipr |")) {
	return "Error: can't run $PR_EDIT";
    }
    chop($_ = <PREDIT>);
    close(PREDIT);
    if ($_ ne "") {
	if (!/exists/) {
	    s/.*by //g; tr/_/ /;
	    return "Problem report $semipr is being edited by $_.\n";
	} else {
	    return "GNATS is currently locked, try again in a moment\n";
	}
    }
    #print "... lock obtained\n";
    return "";
}

# Lock and read the PR into @oldpr and %fieldvalues
# Also sets $semipr and $fullpr
# If second arg is a user name, lock pr.
# Usage: $err = &read_pr(pr_number [, "who is locking"]);
sub read_pr {
    local($pr) = $_[0];
    local($locker) = $_[1];
    # Find category and filename for that PR
    # Sets $semipr and $fullpr
    &pr_get_path($pr);
    # Check for the existence of that PR
    print $fullpr "\n";
    if (!$semipr) {
	return "Sorry, could not find problem report number $pr.\n";
    }
    # lock pr if desired
    if ($locker ne "") {
	local ($err) = "";
	$err = &pr_lock($semipr, $locker);
	return $err if ($err ne "");
    }
    # read in pr
    if (!open(OLDPR, $fullpr)) {
	return "Can't open problem report number $fullpr\n";
    }
    @oldpr = <OLDPR>;
    close(OLDPR);
    # make sure old pr is sane
    if (!@oldpr) {
	return "Error: old problem report file $fullpr is empty!\n";
    }
    # Get field values
    &parse_pr(@oldpr);

    return "";
}

# Convert a responsible-party nickname to an e-mail address
# Usage: ($adr, $err) = &pr_addr($nick);
sub pr_addr
{
    local($nick) = shift(@_);
    local($adr);
    local($err);

    unlink("/tmp/wwwgnats.$$");
    #print "<pre>executing: $PR_ADDR $nick 2&gt; /tmp/wwwgnats.$$ |</pre>\n";
    if (!open(RESP, "$PR_ADDR $nick 2> /tmp/wwwgnats.$$ |")) {
	$err = "Can't get address of responsible party '$nick'";
	return ("", $err);
    }
    $adr = <RESP>;
    chop($adr);
    #print "Got adr = '$adr'\n";
    close(RESP);
    if ($?) {
	$err = "Error: pr-addr returns status $?, and reports:\n";
	if (!open(PRADDR, "/tmp/wwwgnats.$$")) {
	    $err .= "(whoops, no output from pr-addr found; couldn't open /tmp/wwwgnats.$$)\n";
	} else {
	    $err .= join("\n",<PRADDR>);
	    close(PRADDR);
	}
	unlink("/tmp/wwwgnats.$$");
	return ("", $err);
    }
    ($adr, $err);
}


# Read in possible responsible parties
sub read_resp_fullname {
    #  nametag : fullname : e-mail address
    #  db:Dave Benson:david_benson@ccmail.adventure.com
    # Note: in our installation, the nametags are also valid local
    # e-mail aliases.
    local($responsible) = $_[0];
    local($resp_fullname);
    open(RESPON, "$GNATS_ADM/responsible".$domain) ||
	die "Couln't get responsible file\n";
    local($nametag, $fullname, $email);
    while (<RESPON>) {
	if (!/^\s*#|^\s*\n$/) {
	    ($nametag, $fullname, $email) = split(/:/);
	    if ($nametag eq $responsible) {
		$resp_fullname=$fullname;
		last;
	    }
	}
    }
      close(RESPON);

 $resp_fullname;
}


# Read in possible subjects
sub read_subject {
    open(SUBJECT, "$GNATS_ADM/subject".$domain) ||
	return 0;
    while (<SUBJECT>) {
	if (!/^\s*#|^\s*\n$/) {
	    chop;
	    push(@nSubject, $_);
	}
    }
    close(SUBJECT);
    @nSubject = sort(@nSubject);
    return 1;
}


sub change_date {
local($monthname,$daynumber);
local($oldmonthname,$olddaynumber);
($junk,$monthname,$daynumber,$junk2)=split(/ /,localtime(time));
if ($daynumber eq "") {
  $daynumber=$junk2;;
}

if ($DATEVALUE eq "today") {
$DATEVALUE="$monthname+$daynumber";
}


elsif ($DATEVALUE eq "yesterday") {
($junk,$oldmonthname,$olddaynumber,$junk2)=split(/ /,localtime(time-3600*24));
if ($olddaynumber eq "") {
  $olddaynumber=$junk2;
}
if ($oldmonthname eq $monthname) {
$DATEVALUE="$monthname+$olddaynumber|$monthname+$daynumber";
} 
else {
$DATEVALUE="$oldmonthname+$olddaynumber|$monthname+$daynumber";
}
}

elsif ($DATEVALUE eq "last+week") {
($junk,$oldmonthname,$olddaynumber,$junk2)=split(/ /,localtime(time-3600*24*7));
if ($olddaynumber eq "") {
  $olddaynumber=$junk2;
}
$DATEVALUE="";
if ($oldmonthname eq $monthname) {
until ($olddaynumber>$daynumber) {
$DATEVALUE.="$monthname+$olddaynumber|";
$olddaynumber+=1;
}
}
else {
until ($olddaynumber>31) {
$DATEVALUE.="$oldmonthname+$olddaynumber|";
$olddaynumber+=1;
}
$olddaynumber=1;
until ($olddaynumber>$daynumber) {
$DATEVALUE.="$monthname+$olddaynumber|";
$olddaynumber+=1;
}
}
chop($DATEVALUE);
}

elsif ($DATEVALUE eq "last+two+weeks") {
($junk,$oldmonthname,$olddaynumber,$junk2)=split(/ /,localtime(time-3600*24*14));
if ($olddaynumber eq "") {
  $olddaynumber=$junk2;
}
$DATEVALUE="";
if ($oldmonthname eq $monthname) {
until ($olddaynumber>$daynumber) {
$DATEVALUE.="$monthname+$olddaynumber|";
$olddaynumber+=1;
}
}
else {
until ($olddaynumber>31) {
$DATEVALUE.="$oldmonthname+$olddaynumber|";
$olddaynumber+=1;
}
$olddaynumber=1;
until ($olddaynumber>$daynumber) {
$DATEVALUE.="$monthname+$olddaynumber|";
$olddaynumber+=1;
}
}
chop($DATEVALUE);
}

elsif ($DATEVALUE eq "last+month") {
($junk,$oldmonthname,$olddaynumber,$junk2)=split(/ /,localtime(time-3600*24*30));
if ($olddaynumber eq "") {
  $olddaynumber=$junk2;
}
$DATEVALUE="";
until ($olddaynumber>31) {
$DATEVALUE.="$oldmonthname+$olddaynumber|";
$olddaynumber+=1;
}
$olddaynumber=1;
until ($olddaynumber>$daynumber) {
$DATEVALUE.="$monthname+$olddaynumber|";
$olddaynumber+=1;
}
chop($DATEVALUE);
}

elsif ($DATEVALUE eq "manual+input+done") {
local($monthname,$daynumber);
local($oldmonthname,$olddaynumber);
$DATEVALUE="";
($monthname,$daynumber)=split(/\+/,$DATEEND);
($oldmonthname,$olddaynumber)=split(/\+/,$DATESTART);
while ($montharray{$oldmonthname} < $montharray{$monthname}) {
  $DATEVALUE.="$oldmonthname+$olddaynumber|";
  $olddaynumber++;
  if ($olddaynumber > 31) {
    $oldmonthname=$montharray{$montharray{$oldmonthname}+1};
    $olddaynumber=1;
  }
}
while ($olddaynumber <= $daynumber) {
  $DATEVALUE.="$monthname+$olddaynumber|";
  $olddaynumber++;
}
chop($DATEVALUE);
}
}


sub read_domain {
    # category tag : category name : responsible : other-interested-people
    local($domain) = $_[0];
    local(@nCat2);
    #print $domain;
    open(CATEG, "$GNATS_ADM/categories".$domain) ||
	die "Couln't get categories file\n";
    while (<CATEG>) {
	if (!/^\s*#|^\s*\n$/) {
	    ($x, $dummy) = split(/:/);
	    push(@nCat2, $x);
	}
    }
    close(CATEG);
    @nCat2 = sort(@nCat2);   
    unshift(@nCat2, "");  # needed for 'any'
    @nCat2;
}


# Make text safe to display in an HTML stream
sub html_escape
{
    local($tmp) = $_[0];
    $tmp =~ s/</&lt;/g;
    $tmp =~ s/>/&gt;/g;
    return $tmp;
}

# Reads in possible PR originators
# Note: @nOriginator has an extra entry at the top
sub read_originator {
    #  Full_name e-mail@address of originators
    #  Huy_Le Huy_Le@ccmail.adventure.com
    open(ORIGINATOR, "$ORIGIN_FILE") || die "Couldn't get originator file\n";
    while (<ORIGINATOR>) {
	if (!/^\s*(#|\n)/) {
	    ($name, $email) = split(/ /);
	    chop($email);
	    $nOriginator{$name} = $email;
	}
    }
    close(ORIGINATOR);
    @nOriginator = sort(keys(%nOriginator));
    unshift(@nOriginator, "");  # needed for 'any'
}

# Reads in possible PR editors
sub read_editor {
    #  Full_name e-mail@address of editors
    #  Huy_Le Huy_Le@ccmail.adventure.com
    open(EDITOR, "$EDITOR_FILE") || die "Couldn't open editor file $EDITOR_FILE\n";
    while (<EDITOR>) {
	if (!/^\s*(#|\n)/) {
	    ($name, $email) = split(/ /);
	    chop($email);
	    $nEditor{$name} = $email;
	}
    }
    close(EDITOR);
    @nEditor = sort(keys(%nEditor));
}



# Gets the timestamp of the given file
sub timestamp {
    local($fname) = shift(@_);

    open(TIMESTAMP, "$LSPROG -l $fname|")
        || die "Error: can't record the timestamp of the PR ($fname)";
    ($_=<TIMESTAMP>)=~ /\s(\S+\s+\S+\s+\S+)\s+\S+$/
	|| die "Error: can't record the timestamp of the PR ($fname)";
    close(TIMESTAMP);
    local($ts)=$1;
    $ts =~ tr/ /+/;
    $ts =~ tr/:/_/;
    $ts;
}

# Truncate a string to the given width, replacing last shown char with $ if truncated.
# Usage: $fstr = &truncstr("long string", $width);
sub truncstr {
    local($str) = shift(@_);
    local($WIDTH) = shift(@_);
    local($W, $fstring);
    # Truncate or pad the variable to the desired width.
    $W=$WIDTH;
    if (length($str)>$WIDTH && $WIDTH) { --$W };
    $fstring = sprintf("%-${W}s",$WIDTH?substr($str,0,$W):$str);
    # Add a $ if we truncated it.
    if (length($str)>$WIDTH && $WIDTH) {
	$fstring .= "\$";
    }
    return $fstring;
}


sub by_priority_and_number {
    local($priority11,$number1,$number2,$priority2);
    ($priority1,$number1,$junk)=split(/\|/,$a,3);
    ($priority2,$number2,$junk)=split(/\|/,$b,3);
    if ($priority1 < $priority2) {
	return -1;
    }
    if ($priority1 == $priority2) {
	if ($number1 < $number2) {
	    return -1;
	} else {
	    return 1;
	}	
    }
    return 1;
}

sub listing {
  local($number)=shift(@_);
  open(TMP,">> $GNATS_LIB/../www/Web/listing$$");
  $err = &read_pr($number, "");
  if ($err ne "") {
    print "$err\n";
  } else {
    print TMP "<H2>Full text of Problem Report number $number :</H2>
";
    print TMP "<pre>\n";
    $prtext = &html_escape(join("",@oldpr));
    $prtext =~ s/&gt;([\w-]*):/<strong>$1<\/strong>:/g;
    $prtext =~ s#From(.*?)<strong>#<strong>#s;
    $prtext =~ s#<strong>Audit-Trail.*##s;
    print TMP $prtext;
    print TMP "</pre><HR>\n\n";
    close(TMP);
  }
}
  
  
sub dates_manual_input {
local($monthname,$daynumber);
local($oldmonthname,$olddaynumber);
($junk,$monthname,$daynumber,$junk2,$junk3)=split(/ /,localtime(time));
if ($daynumber eq "") {
  $daynumber=$junk2;
  $default_for_start_date="$monthname $daynumber $junk3";
} else {
$default_for_start_date="$monthname $daynumber $junk2";
}
($junk,$oldmonthname,$olddaynumber,$junk2)=split(/ /,localtime(time-3600*24*7));
if ($olddaynumber eq "") {
  $olddaynumber=$junk2;
}
$seven_days_ago="$oldmonthname $olddaynumber";
$date_of_today="$monthname $daynumber";
}

