/source/cgi-bin/gnatsweb.pl

Large files files are truncated, but you can click here to view the full file

#!/usr/bin/perl -w
#
# Gnatsweb - web front-end to gnats
#
# Copyright 1998-1999 - Matt Gerassimoff
# and Ken Cox
#
# $Id: gnatsweb.pl,v 1.1.1.1.2.31 2001/11/26 10:59:48 yngves Exp $
#

#-----------------------------------------------------------------------------
# Site-specific customization -
#
#     WE STRONGLY SUGGEST you don't edit these variables here, but instead
#     put them in a file called 'gnatsweb-site.pl' in the same directory.
#     That way, when a new version of gnatsweb is released, you won't
#     need to edit them again.
#

# Info about your gnats host.
$site_gnats_host = 'localhost';
$site_gnats_port = 1529;

# Set to true if you compiled gnats with GNATS_RELEASE_BASED defined.
$site_release_based = 0;

# Name you want in the page banner and banner color.
$site_banner_text = 'gnatsweb';
$site_banner_background = '#000000';
$site_banner_foreground = '#ffffff';
$site_button_foreground = '#ffffff';
$site_button_background = '#000000';

# Page background color -- not used unless defined.
#$site_background = '#c0c0c0';
#GCC-LOCAL begin.
$site_background = '#ffffff';
#GCC-LOCAL end.

# Uncomment the following line and insert stylesheet URL in order to
# link all generated pages to an external stylesheet. Both absolute
# and relative URLs are supported.
#$site_stylesheet='http://url.of/stylesheet';

# When $include_audit_trail is set to 1, the Audit-Trail will be
# visible by default in the View PR screen.  Sites that expect large
# Audit-Trails, i.e. lot of mail back and forth etc., will want to set
# this to 0.
$include_audit_trail = 1;

# Have the HTTP header, start_html, heading already been printed?
my $print_header_done = 0;
my $page_start_html_done = 0;
my $page_heading_done = 0;

# Program to send email notifications.
if (-x '/usr/sbin/sendmail')
{
  $site_mailer = '/usr/sbin/sendmail -oi -t';
}
elsif (-x '/usr/lib/sendmail')
{
  $site_mailer = '/usr/lib/sendmail -oi -t';
}
else
{
  die("Can't locate 'sendmail'; must set \$site_mailer in gnats-site.pl");
}

# site_callback -
#
#     If defined, this subroutine gets called at various times.  The
#     reason it is being called is indicated by the $reason argument.
#     It can return undef, in which case gnatsweb does its default
#     thing.  Or, it can return a piece of HTML to implement
#     site-specific behavior or appearance.
#
#     Sorry, the reasons are not documented.  Either put a call to
#     'warn' into your gnats-site.pl file, or search this file for 'cb('.
#     For examples of some of the things you can do with the site_callback
#     subroutine, see gnatsweb-site-sente.pl.
#
# arguments:
#     $reason - reason for the call.  Each reason is unique.
#     @args   - additional parameters may be provided in @args.
#
# returns:
#     undef     - take no special action
#     string    - string is used by gnatsweb according to $reason
#
# example:
#     See gnatsweb-site-sente.pl for an extended example.
#
#     sub site_callback {
#         my($reason, @args) = @_;
#         if ($reason eq 'sendpr_description') {
#             return 'default description text used in sendpr form';
#         }
#         undef;
#     }
#

# end customization
#-----------------------------------------------------------------------------

# Use CGI::Carp first, so that fatal errors come to the browser, including
# those caused by old versions of CGI.pm.
use CGI::Carp qw/fatalsToBrowser/;
# 8/22/99 kenstir: CGI.pm-2.50's file upload is broken.
# 9/19/99 kenstir: CGI.pm-2.55's file upload is broken.
use CGI 2.56 qw(-oldstyle_urls :all);
use gnats qw/client_init client_exit client_cmd/;
use Text::Tabs;

# Debugging fresh code.
#$gnats::DEBUG_LEVEL = 2;

# Version number + RCS revision number
$VERSION = '2.9.3';
$REVISION = (split(/ /, '$Revision: 1.1.1.1.2.31 $ '))[1];

# width of text fields
$textwidth = 60;

# where to get help -- a web site with translated info documentation
$gnats_info_top = 'http://www.gnu.org/software/gnats/gnats_toc.html';
#GCC-LOCAL begin.
$gnats_info_top = '/gnats.html';
#GCC-LOCAL begin.

# bits in %fieldnames has (set=yes not-set=no)
$MULTILINE    = 1;   # whether field is multi line
$SENDEXCLUDE  = 2;   # whether the send command should exclude the field
$REASONCHANGE = 4;   # whether change to a field requires reason
$ENUM         = 8;   # whether field should be displayed as enumerated
$EDITEXCLUDE  = 16;  # if set, don't display on edit page
$AUDITINCLUDE = 32;  # if set, save changes in Audit-Trail

$| = 1; # flush output after each print

# Return true if module MIME::Base64 is available.  If available, it's
# loaded the first time this sub is called.
sub can_do_mime
{
  return $can_do_mime if (defined($can_do_mime));

  # Had to basically implement 'require' myself here, otherwise perl craps
  # out into the browser window if you don't have the MIME::Base64 package.
  #$can_do_mime = eval 'require MIME::Base64';
  ITER: {
    foreach my $dir (@INC) {
      my $filename = "$dir/MIME/Base64.pm";
      if (-f $filename) {
        do $filename;
        die $@ if $@;
        $can_do_mime = 1;
        last ITER;
      }
    }
    $can_do_mime = 0;
  }
  #warn "NOTE: Can't use file upload feature without MIME::Base64 module\n";
  return $can_do_mime;
}

# Take the file attachment's file name, and return only the tail.  Don't
# want to store any path information, for security and clarity.  Support
# both DOS-style and Unix-style paths here, because we have both types of
# clients.
sub attachment_filename_tail
{
  my($filename) = @_;
  $filename =~ s,.*/,,;  # Remove leading Unix path elements.
  $filename =~ s,.*\\,,; # Remove leading DOS path elements.

  return $filename;
}

# Retrieve uploaded file attachment.  Return it as
# ($filename, $content_type, $data).  Returns (undef,undef,undef)
# if not present.
#
# See 'perldoc CGI' for details about this code.
sub get_attachment
{
  my $upload_param_name = shift;
  my $debug = 0;
  my $filename = $q->param($upload_param_name);
  return (undef, undef, undef) unless $filename;

  # 9/6/99 kenstir: My testing reveals that if uploadInfo returns undef,
  # then you can't read the file either.
  warn "get_attachment: filename=$filename\n" if $debug;
  my $hashref = $q->uploadInfo($filename);
  if (!defined($hashref)) {
    die "Got attachment filename ($filename) but no attachment data!  Probably this is a programming error -- the form which submitted this data must be multipart/form-data (start_multipart_form()).";
  }
  if ($debug) {
    while (($k, $v) = each %$hashref) {
      warn "get_attachment: uploadInfo($k)=$v\n";
    }
  }

  # 9/6/99 kenstir: When testing locally on Linux, a .gz file yielded
  # no Content-Type.  Therefore, have to assume binary.  Would like to
  # check (-B $fh) to see if the stream is binary but that doesn't work.
  my $ctype = $hashref->{'Content-Type'} || 'application/octet-stream';
  warn "get_attachment: Content-Type=$ctype\n" if $debug;

  my $data = '';
  my $buf;
  my $fh = $q->upload($upload_param_name);
  warn "get_attachment: fh=$fh\n" if $debug;
  while (read($fh, $buf, 1024)) {
    $data .= $buf;
  }
  close $fh;

  return ($filename, $ctype, $data);
}

# Retrieve uploaded file attachment, and encode it so that it's 
# printable, for inclusion into the PR text.
#
# Returns the printable text representing the attachment.  Returns '' if
# the attachment was not present.
sub encode_attachment
{
  my $upload_param_name = shift;
  my $debug = 0;

  return '' unless can_do_mime();

  my ($filename, $ctype, $data) = get_attachment($upload_param_name);
  return '' unless $filename;

  # Strip off path elements in $filename.
  $filename = attachment_filename_tail($filename);

  warn "encode_attachment: $filename was ", length($data), " bytes of $ctype\n"
        if $debug;
  my $att = '';

  # Plain text is included inline; all else is encoded.
  $att .= "Content-Type: $ctype; name=\"$filename\"\n";
  if ($ctype eq 'text/plain') {
    $att .= "Content-Disposition: inline; filename=\"$filename\"\n\n";
    $att .= $data;
  }
  else {
    $att .= "Content-Transfer-Encoding: base64\n";
    $att .= "Content-Disposition: attachment; filename=\"$filename\"\n\n";
    $att .= MIME::Base64::encode_base64($data);
  }
  warn "encode_attachment: done\n" if $debug;

  return $att;
}

# Takes the encoded file attachment, decodes it and returns it as a hashref.
sub decode_attachment
{
  my $att = shift;
  my $debug = 0;
  my $hash_ref = {'original_attachment' => $att};

  # Split the envelope from the body.
  my ($envelope, $body) = split(/\n\n/, $att, 2);
  return $hash_ref unless ($envelope && $body);

  # Split mbox-like headers into (header, value) pairs, with a leading
  # "From_" line swallowed into USELESS_LEADING_ENTRY. Junk the leading
  # entry. Chomp all values.
  %$hash_ref = (USELESS_LEADING_ENTRY => split /^(\S*?):\s*/m, $envelope);
  delete($hash_ref->{USELESS_LEADING_ENTRY});
  for (keys %$hash_ref) {
    chomp $hash_ref->{$_};
  }

  # Keep the original_attachment intact.
  $$hash_ref{'original_attachment'} = $att;

  if (!$$hash_ref{'Content-Type'}
      || !$$hash_ref{'Content-Disposition'})
  {
    die "Unable to parse file attachment";
  }

  # Parse filename.
  # Note: the extra \ before the " is just so that perl-mode can parse it.
  if ($$hash_ref{'Content-Disposition'} !~ /(\S+);\s*filename=\"([^\"]+)\"/) {
    die "Unable to parse file attachment Content-Disposition";
  }
  $$hash_ref{'filename'} = attachment_filename_tail($2);

  # Decode the data if encoded.
  if (exists($$hash_ref{'Content-Transfer-Encoding'})
      && $$hash_ref{'Content-Transfer-Encoding'} eq 'base64')
  {
    $$hash_ref{'data'} = MIME::Base64::decode_base64($body);
  }
  else {
    $$hash_ref{'data'} = $body;
  }

  return $hash_ref;
}

# Print file attachment browser and buttons to download the attachments.
# Which of these appear depend on the mode.
sub print_attachments
{
  my($fields_hash_ref, $mode) = @_;

  return unless can_do_mime();

  print "<tr><td valign=top><b>File Attachments:</b></td>\n<td>";

  # Add file upload button for adding new attachment.
  if ($mode eq 'sendpr' || $mode eq 'edit') {
    print "Add a file attachment:<br>",
          $q->filefield(-name=>'attached_file',
                        -size=>50);
  }

  # Print table of existing attachments.
  # Add column with delete button in edit mode.
  my $array_ref = $$fields_hash_ref{'attachments'};
  my $table_rows_aref = [];
  my $i = 0;
  foreach $hash_ref (@$array_ref) {
    my $size = int(length($$hash_ref{'data'}) / 1024.0);
    $size = 1 if ($size < 1);
    my $row_data = $q->td( [ $q->submit('cmd', "download attachment $i"),
                             $$hash_ref{'filename'},
                             "${size}k" ] );
    $row_data .= $q->td($q->checkbox(-name=>'delete attachments',
                                     -value=>$i,
                                     -label=>"delete attachment $i"))
          if ($mode eq 'edit');
    push(@$table_rows_aref, $row_data);
    $i++;
  }
  if (@$table_rows_aref)
  {
    my $header_row_data = $q->th( ['download','filename','size' ] );
    $header_row_data .= $q->th('delete')
          if ($mode eq 'edit');
    print $q->table({-border=>1},
                    $q->Tr($header_row_data),
                    $q->Tr($table_rows_aref));
  }
}

# The user has requested download of a particular attachment.
# Serve it up.
sub download_attachment
{
  my $attachment_number = shift;
  my($pr) = $q->param('pr');
  die "download_attachment called with no PR number"
        if(!$pr);

  my(%fields) = readpr($pr);
  my $array_ref = $fields{'attachments'};
  my $hash_ref = $$array_ref[$attachment_number];

  # Determine the attachment's content type.
  my $ct = $$hash_ref{'Content-Type'} || 'application/octet-stream';
  $ct =~ s~\s*;.*~~s;

  my $disp;

  # Internet Explorer 5.5 does not handle "content-disposition: attachment"
  # in the expected way. It needs a content-disposition of "file".
  ($ENV{'HTTP_USER_AGENT'} =~ "MSIE 5.5") ? ($disp = 'file') : ($disp = 'attachment');
  # Now serve the attachment, with the appropriate headers.
  print $q->header(-type => $ct,
                   -content_disposition => "$disp; filename=\"$$hash_ref{'filename'}\""),
  $$hash_ref{'data'};
}

# Add the given (gnatsweb-encoded) attachment to the %fields hash.
sub add_encoded_attachment_to_pr
{
  my($fields_hash_ref, $encoded_attachment) = @_;
  return unless $encoded_attachment;
  my $ary_ref = $$fields_hash_ref{'attachments'} || [];
  my $hash_ref = { 'original_attachment' => $encoded_attachment };
  push(@$ary_ref, $hash_ref);
  $$fields_hash_ref{'attachments'} = $ary_ref;
}

# Add the given (gnatsweb-decoded) attachment to the %fields hash.
sub add_decoded_attachment_to_pr
{
  my($fields_hash_ref, $decoded_attachment_hash_ref) = @_;
  return unless $decoded_attachment_hash_ref;
  my $ary_ref = $$fields_hash_ref{'attachments'} || [];
  push(@$ary_ref, $decoded_attachment_hash_ref);
  $$fields_hash_ref{'attachments'} = $ary_ref;
}

# Remove the given attachments from the %fields hash.
sub remove_attachments_from_pr
{
  my($fields_hash_ref, @attachment_numbers) = @_;
  return unless @attachment_numbers;
  my $ary_ref = $$fields_hash_ref{'attachments'} || [];
  foreach my $attachment_number (@attachment_numbers)
  {
    # Remove the attachment be replacing it with the empty hash.
    # The sub unparsepr skips these.
    $$ary_ref[$attachment_number] = {};
  }
}

# wrapper functions for formstart...
sub multipart_form_start
{
  formstart(1, @_);
}
sub form_start
{
  formstart(0, @_);
}

# workaround for an exceedingly dumb netscape bug.  we hates
# netscape...  this bug manifests if you click on the "create"
# button bar link (but not the grey button on the main page), submit a
# PR, then hit the back button (usually because you got an error).
# you're taken "back" to the same error page -- all the stuff you
# entered into the submission form is *gone*.  this is kind of annoying...
# (it also manifests if you click the edit link from the query results page.)
sub formstart
{
  # this bugfix is mostly lifted from the CGI.pm docs.  here's what they
  # have to say:
  #   When you press the "back" button, the same page is loaded, not
  #   the previous one.  Netscape's history list gets confused
  #   when processing multipart forms. If the script generates
  #   different pages for the form and the results, hitting the
  #   "back" button doesn't always return you to the previous page;
  #   instead Netscape reloads the current page. This happens even
  #   if you don't use an upload file field in your form.
  #
  #   A workaround for this is to use additional path information to
  #   trick Netscape into thinking that the form and the response
  #   have different URLs. I recommend giving each form a sequence
  #   number and bumping the sequence up by one each time the form
  #   is accessed:

  # should we do multipart?
  my $multi = shift;
  
  # in case the caller has some args to pass...
  my %args = @_;
  
  # if the caller has given an "action" arg, we don't do any
  # subterfuge.  let the caller worry about the bug...
  if (!exists $args{'-action'})
  {
    # get sequence number and increment it
    my $s = $q->path_info =~ m{/(\d+)/?$};
    $s++;
    # Trick Netscape into thinking it's loading a new script:
    $args{-action} = $q->script_name . "/$s";
  }
    
  if ($multi)
  {
    print $q->start_multipart_form(%args);
  }
  else
  {
    print $q->start_form(%args);
  }  
  return;
}

# sendpr -
#     The Create PR page.
#
sub sendpr
{
  my $page = 'Create PR';
  print_header();
  page_start_html($page);
  page_heading($page, 'Create Problem Report', 1);

  # remove "all" from arrays
  shift(@category);
  shift(@severity);
  shift(@priority);
  shift(@class);
  shift(@confidential);
  shift(@responsible);
  shift(@state);
  shift(@submitter_id);

  # Add '<default>' to @responsible, in case the site_callback alows
  # Responsible to be set upon submission.  This is filtered out in
  # &submitnewpr.
  unshift(@responsible, '<default>');

  print multipart_form_start(-name=>'sendPrForm'), "\n",
        hidden_db(),
	$q->p($q->submit('cmd', 'submit'),
	" or ",
	$q->reset(-name=>'reset')),
    $q->hidden(-name=>'return_url'),
	"<hr>\n",
	"<table>";
  my $def_email = $global_prefs{'email'}
        || cb('get_default_value', 'email') || '';
  print "<tr>\n<td><b>Reporter's email:</b></td>\n<td>",
        $q->textfield(-name=>'email',
                      -default=>$def_email,
                      -size=>$textwidth),
	"</td>\n</tr>\n<tr>\n<td><b>CC these people<br>on PR status email:</b></td>\n<td>",
	$q->textfield(-name=>'X-GNATS-Notify',
		      -size=>$textwidth),
        # a blank row, to separate header info from PR info
        "</td>\n</tr>\n<tr>\n<td>&nbsp;</td>\n<td>&nbsp;</td>\n</tr>\n";

  foreach (@fieldnames)
  {
    next if ($fieldnames{$_} & $SENDEXCLUDE);
    my $lc_fieldname = field2param($_);

    # Get default value from site_callback if provided, otherwise take
    # our defaults.
    my $default;
    $default = 'serious'                   if /Severity/;
    $default = 'medium'                    if /Priority/;
    $default = $global_prefs{'Submitter-Id'} || 'unknown' if /Submitter-Id/;
    #GCC-LOCAL begin.
    $default = 'net' if /Submitter-Id/;
    #GCC-LOCAL end.
    $default = $global_prefs{'Originator'} if /Originator/;
    $default = grep(/^unknown$/i, @category) ? "unknown" : $category[0]
                                           if /Category/;
    $default = $config{'DEFAULT_RELEASE'}  if /Release/;
    $default = ''                          if /Responsible/;
    $default = cb("sendpr_$lc_fieldname") || $default;

    # The "intro" provides a way for the site callback to print something
    # at the top of a given field.
    my $intro = cb("sendpr_intro_$lc_fieldname") || '';

    if ($fieldnames{$_} & $ENUM)
    {
      if ($lc_fieldname eq "category")
      {
        print "<tr>\n<td><b>$_:</b>\n</td>\n<td>",
        $intro,
        $q->popup_menu(-name=>$_,
                       -values=>\@$lc_fieldname,
                       -labels=>\%category_desc,
                       -default=>$default);
        print "</td>\n</tr>\n";
      }
      elsif ($lc_fieldname eq "responsible")
      {
        print "<tr>\n<td><b>$_:</b>\n</td>\n<td>",
        $intro,
        $q->popup_menu(-name=>$_,
                       -values=>\@$lc_fieldname,
                       -labels=>\%responsible_fullname,
                       -default=>$fields{$_});
        print "</td>\n</tr>\n";
      } else
      {  
        print "<tr>\n<td><b>$_:</b>\n</td>\n<td>",
        $intro,
        $q->popup_menu(-name=>$_,
                       -values=>\@$lc_fieldname,
                       -default=>$default);
        print "</td>\n</tr>\n";
      }
    }

    elsif ($fieldnames{$_} & $MULTILINE)
    {
      my $rows = 4;
      $rows = 8 if /Description/;
      $rows = 2 if /Environment/;

      #GCC-LOCAL begin.
      if ($lc_fieldname eq "description")
      {
        printf "<tr>\n<td></td>\n<td>When you provide (preprocessed) source, "
               ."please only insert it into one of the text fields if it is "
               ."very small, say below 50 lines. Else <em>please</em> attach "
               ."it as a file (see below).";
      }
      #GCC-LOCAL end.

      print "<tr>\n<td valign=top><b>$_:</b></td>\n<td>",
            $intro,
            $q->textarea(-name=>$_,
                         -cols=>$textwidth,
                         -rows=>$rows,
                         -default=>$default);
      # Create file upload button after Description.
      print_attachments(\%fields, 'sendpr') if /Description/;
      print "</td>\n</tr>\n";
    }
    else
    {
      print "<tr>\n<td><b>$_:</b></td>\n<td>",
            $intro,
            $q->textfield(-name=>$_,
                          -size=>$textwidth,
                          -default=>$default);
      print "</td>\n</tr>\n";
    }
    print "\n";
  }
  print "</table>",
	$q->p($q->submit('cmd', 'submit'),
	" or ",
	$q->reset(-name=>'reset')),
	$q->end_form();

  page_footer($page);
  page_end_html($page);
}

# validate_email_field -
#     Used by validate_new_pr to check email address fields in a new PR.
sub validate_email_field
{
  my($fieldname, $fieldval, $required) = @_;

  my $blank = ($fieldval =~ /^\s*$/);
  if ($required && $blank)
  {
    return "$fieldname is blank";
  }
  # From rkimball@vgi.com, allows @ only if it's followed by what looks
  # more or less like a domain name.
  my $email_addr = '[^@\s]+(@\S+\.\S+)?';
  if (!$blank && $fieldval !~ /^\s*($email_addr\s*)+$/)
  {
    return "'$fieldval' doesn't look like a valid email address (xxx\@xxx.xxx)";
  }
  return '';
}

# validate_new_pr -
#     Make sure fields have reasonable values before submitting a new PR.
sub validate_new_pr
{
  my(%fields) = @_;
  my(@errors) = ();
  my $err;

  # validate email fields
  $err = validate_email_field('E-mail Address', $fields{'email'}, 'required');
  push(@errors, $err) if $err;
#  $err = validate_email_field('CC', $fields{'cc'});
#  push(@errors, $err) if $err;
  $err = validate_email_field('X-GNATS-Notify', $fields{'X-GNATS-Notify'});
  push(@errors, $err) if $err;

  # validate some other fields
  push(@errors, "Category is blank or 'unknown'")
        if($fields{'Category'} =~ /^\s*$/ || $fields{'Category'} eq "unknown");
  push(@errors, "Synopsis is blank")
        if($fields{'Synopsis'} =~ /^\s*$/);
  push(@errors, "Release is blank")
        if($fields{'Release'} =~ /^\s*$/);
  push(@errors, "Submitter-Id is 'unknown'")
        if($fields{'Submitter-Id'} eq 'unknown');
  #GCC-LOCAL begin.
  push(@errors, "Priority is 'high'")
	if($fields{'Priority'} eq 'high');
  #GCC-LOCAL end.

  @errors;
}

sub submitnewpr
{
  my $page = 'Create PR Results';

  my $debug = 0;
  my(@values, $key);
  my(%fields);

  foreach $key ($q->param)
  {
    my $val = $q->param($key);
    if($fieldnames{$key} && ($fieldnames{$key} & $MULTILINE))
    {
      $val = fix_multiline_val($val);
    }
    $fields{$key} = $val;
  }

  # If Responsible is '<default>', delete it; gnats handles that.  See
  # also &sendpr.
  if(defined($fields{'Responsible'}) && $fields{'Responsible'} eq '<default>') {
    delete $fields{'Responsible'};
  }

  # Make sure the pr is valid.
  my(@errors) = validate_new_pr(%fields);
  if (@errors)
  {
    print_header();
    page_start_html($page);
    page_heading($page, 'Error');
    print "<h3>Your problem report has not been sent.</h3>\n",
          "<p>Fix the following problems, then submit the problem report again:</p>",
          $q->ul($q->li(\@errors));
    return;
  }

  # Supply a default value for Originator
  $fields{'Originator'} = $fields{'Originator'} || $fields{'email'};

  # Handle the attached_file, if any.
  add_encoded_attachment_to_pr(\%fields, encode_attachment('attached_file'));

  # Compose the message
  my $text = unparsepr('send', %fields);
  $text = <<EOT . $text;
To: $config{'GNATS_ADDR'}
CC: $fields{'X-GNATS-Notify'}
Subject: $fields{'Synopsis'}
From: $fields{'email'}
Reply-To: $fields{'email'}
X-Send-Pr-Version: gnatsweb-$VERSION ($REVISION)
X-GNATS-Notify: $fields{'X-GNATS-Notify'}

EOT

  # Allow debugging
  if($debug)
  {
    print_header();
    page_start_html($page);
    print "<h3>debugging -- PR NOT SENT</h3>",
          $q->pre($q->escapeHTML($text)),
          "<hr>";
    page_end_html($page);
    return;
  }

  # Send the message
  if(!open(MAIL, "|$site_mailer"))
  {
    print_header();
    page_start_html($page);
    page_heading($page, 'Error');
    print "<h3>Error invoking $site_mailer</h3>";
    return;
  }
  print MAIL $text;
  if(!close(MAIL))
  {
    print_header();
    page_start_html($page);
    page_heading($page, 'Error');
    print "<h3>Bad pipe to $site_mailer</h3>";
    exit;
   }

  # Return the user to the page they were viewing when they pressed
  # 'create'.
  my $return_url = $q->param('return_url') || get_script_name();
  my $refresh = 5;
  print_header(-Refresh => "$refresh; URL=$return_url",
               -cookie => create_global_cookie());
  # Workaround for MSIE:
  my @args = (-title=>"$page - $site_banner_text");
  push(@args, -bgcolor=>$site_background)
          if defined($site_background);
  push(@args, -style=>{-src=>$site_stylesheet})
        if defined($site_stylesheet);
  push(@args, -head=>meta({-http_equiv=>'Refresh',
                           -content=>"$refresh; URL=$return_url"}));
  print $q->start_html(@args);

  # Print page banner, with button bar, without the <head> part:
  page_start_html($page, 0, 1);

  page_heading($page, 'Problem Report Sent');

  print "<p>Thank you for your report.  It will take a short while for
your report to be processed.  When it is, you will receive
an automated message about it, containing the Problem Report
number, and the developer who has been assigned to
investigate the problem.</p>";

  print "<p>Page will refresh in $refresh seconds...</p>\n";

  page_footer($page);
  page_end_html($page);
}

# Return a URL which will take one to the specified $pr and with a
# specified $cmd.  For commands such as 'create' that have no
# associated PR number, we pass $pr = 0, and this routine then leaves
# out the pr parameter.  For ease of use, when the user makes a
# successful edit, we want to return to the URL he was looking at
# before he decided to edit the PR.  The return_url param serves to
# store that info, and is included if $include_return_url is
# specified.  Note that the return_url is saved even when going into
# the view page, since the user might go from there to the edit page.
#
sub get_pr_url
{
  my($cmd, $pr, $include_return_url) = @_;
  my $url = $q->url() . "?cmd=$cmd&database=$global_prefs{'database'}";
  $url .= "&pr=$pr" if $pr;
  $url .= "&return_url=" . $q->escape($q->self_url())
        if $include_return_url;
  return $url;
}

# Return a URL to edit the given pr.  See get_pr_url().
#
sub get_editpr_url
{
  return get_pr_url('edit', @_);
}

# Return a URL to view the given pr.  See get_pr_url().
#
sub get_viewpr_url
{
  my $viewcmd = $include_audit_trail ? 'view%20audit-trail' : 'view';
  return get_pr_url($viewcmd, @_);
}

# Return a URL to create a pr.  See get_pr_url().
#
sub get_createpr_url
{
  return get_pr_url('create', @_);
}

# Same as script_name(), but includes 'database=xxx' param.
#
sub get_script_name
{
  my $url = $q->script_name();
  $url .= "?database=$global_prefs{'database'}"
        if defined($global_prefs{'database'});
  return $url;
}

# Return a link which sends email regarding the current PR.
sub get_mailto_link
{
  my($pr,%fields) = @_;

  # NOTE: cagney/2003-01-31: Don't escape the interested parties
  # e-mail list.  MOZILLA has a nasty bug were it doesn't re-adjust
  # the e-mail list length after de-escaping it.  This causes MOZILLA
  # to use "?Sub..." in the list of e-mail addresses.

  # my $mailto  = $q->escape(scalar(interested_parties($pr, 1, %fields)));
  my $mailto  = interested_parties($pr, 1, %fields);

  my $subject = $q->escape("Re: $fields{'Category'}/$pr: $fields{'Synopsis'}");
  my $body    = $q->escape(get_viewpr_url($pr));

  return "<a href=\"mailto:$mailto?Subject=$subject&Body=$body\">"
        . "send email to interested parties</a>\n";
}

# Look for text that looks like URLs and turn it into actual links.
sub mark_urls
{
  my ($val) = @_;
  # This probably doesn't catch all URLs, but one hopes it catches the
  # majority.
  $val =~ s/\b((s?https?|ftp):\/\/[-a-zA-Z0-9_.]+(:[0-9]+)?[-a-zA-Z0-9_\$.+\!*\(\),;:\@\&\%\x93\x90=?~\#\/]*)/
        \<a href="$1">$1\<\/a\>/g;
  return $val;
}

sub view
{
  my($viewaudit, $tmp) = @_;
  # $pr must be 'local' to be available to site callback
  local($pr) = $q->param('pr');
  if(!$pr)
  {
    error_page('Error', 'You must specify a problem report number');
    return;
  }
  if($pr =~ /\D/)
  {
    error_page('Error', 'Invalid PR number');
    return;
  }
  my $page = "View PR $pr";
  print_header();
  page_start_html($page);
  page_heading($page, "View Problem Report: $pr", 1);

  # %fields must be 'local' to be available to site callback
  local(%fields) = readpr($pr);

  print $q->start_form(),
        hidden_db(),
	$q->hidden('pr'),
        $q->hidden('return_url');

  # print 'edit' and 'view audit-trail' buttons as appropriate, mailto link
  print "<p>";
  print $q->submit('cmd', 'edit')             if (can_edit());
  print " or "                                if (can_edit() && !$viewaudit);
  print $q->submit('cmd', 'view audit-trail') if (!$viewaudit);
  print " or ",
        get_mailto_link($pr, %fields), "</p>";
  print $q->hr(),
        "<table>\n";
  print "<tr>\n<td><b>Reporter's email:</b></td>\n<td>",
        $q->tt($fields{'Reply-To'}),
#	"<tr><td><b>Others to notify<br>of updates to this PR:</b><td>",
	"</td>\n</tr>\n<tr>\n<td><b>CC these people<br>on PR status email:</b></td>\n<td>",
	$q->tt($fields{'X-GNATS-Notify'}),
        # a blank row, to separate header info from PR info
        "</td>\n</tr>\n<tr>\n<td>&nbsp;</td>\n<td>&nbsp;</td>\n</tr>\n";

  foreach (@fieldnames)
  {
    next if $_ eq 'Audit-Trail';
    my $val = $q->escapeHTML($fields{$_}) || ''; # to avoid -w warning
    my $valign = '';
    if ($fieldnames{$_} & $MULTILINE)
    {
      $valign = 'valign=top';
      $val = expand($val);
      $val =~ s/$/<br>/gm;
      $val =~ s/<br>$//; # previous substitution added one too many <br>'s
      $val =~ s/  /&nbsp; /g;
      $val =~ s/&nbsp;  /&nbsp; &nbsp;/g;
      $val = mark_urls($val);
    }
    print "<tr><td $valign nowrap><b>$_:</b></td>\n<td>",
          $q->tt($val), "\n";
    # Print attachments after Description.
    if (/Description/) {
      print "</td>\n</tr>\n";
      print_attachments(\%fields, 'view');
    }
    print "</td>\n</tr>\n"
  }
  print "</table>",
        $q->hr();

  # print 'edit' and 'view audit-trail' buttons as appropriate, mailto link
  print "\n<p>";
  print $q->submit('cmd', 'edit')             if (can_edit());
  print " or "                                if (can_edit() && !$viewaudit);
  print $q->submit('cmd', 'view audit-trail') if (!$viewaudit);
  print " or ",
        get_mailto_link($pr, %fields);
  print "</p>\n";
  print $q->end_form();

  # Footer comes before the audit-trail.
  page_footer($page);

  if($viewaudit)
  {
    print "<h3>Audit Trail:</h3>\n",
          mark_urls($q->pre($q->escapeHTML($fields{'Audit-Trail'})));
  }

  page_end_html($page);
}

# edit -
#     The Edit PR page.
#
sub edit
{
  #my $debug = 0; # no debug code in here
  my($pr) = $q->param('pr');
  if(!$pr)
  {
    error_page('Error', 'You must specify a problem report number');
    return;
  }

  if($pr =~ /\D/)
  {
    error_page('Error', 'Invalid PR number');
    return;
  }

  my $page = "Edit PR $pr";
  print_header();
  page_start_html($page);
  page_heading($page, "Edit Problem Report: $pr", 1);

  # Read the PR.
  my(%fields) = readpr($pr);

  # Trim Responsible for compatibility.
  $fields{'Responsible'} = trim_responsible($fields{'Responsible'});

  # remove "all" from arrays
  shift(@category);
  shift(@severity);
  shift(@priority);
  shift(@class);
  shift(@confidential);
  shift(@responsible);
  shift(@state);
  shift(@submitter_id);

  print multipart_form_start(-name=>'editPrForm'), "\n",
        hidden_db(),
        $q->p($q->submit('cmd', 'submit edit'),
        " or ",
        $q->reset(-name=>'reset'),
        " or ",
        get_mailto_link($pr, %fields)),
	$q->hidden(-name=>'Editor',
                   -value=>$db_prefs{'user'},
                   -override=>1),
	$q->hidden(-name=>'Last-Modified',
		   -value=>$fields{'Last-Modified'},
		   -override=>1),
	$q->hidden(-name=>'pr'),
    $q->hidden(-name=>'return_url'),
        "<hr>\n";

  print "<table>\n";
  print "<tr>\n<td><b>Reporter's email:</b></td>\n<td>",
        $q->textfield(-name=>'Reply-To',
                      -default=>$fields{'Reply-To'},
                      -size=>$textwidth),
#	"<tr><td><b>Others to notify<br>of updates to this PR:</b><td>",
	"</td>\n</tr>\n<tr>\n<td><b>CC these people<br>on PR status email:</b></td>\n<td>",
	$q->textfield(-name=>'X-GNATS-Notify',
                      -default=>$fields{'X-GNATS-Notify'},
		      -size=>$textwidth),
        # a blank row, to separate header info from PR info
        "</td>\n</tr>\n<tr>\n<td>&nbsp;</td>\n<td>&nbsp;</td>\n</tr>\n";

  foreach (@fieldnames)
  {
    next if ($fieldnames{$_} && ($fieldnames{$_} & $EDITEXCLUDE));
    my $lc_fieldname = field2param($_);

    # The "intro" provides a way for the site callback to print something
    # at the top of a given field.
    my $intro = cb("edit_intro_$lc_fieldname") || '';

    if ($fieldnames{$_} && ($fieldnames{$_} & $ENUM))
    {
      my @values = cb('edit_pr', $fields{'Category'}, $lc_fieldname);
      @values = @$lc_fieldname unless (defined($values[0]));
      if ($lc_fieldname eq "category")
      {
        print "<tr>\n<td><b>$_:</b>\n</td>\n<td>",
        $intro,
        $q->popup_menu(-name=>$_,
                       -values=>\@values,
                       -labels=>\%category_desc,
                       -default=>$fields{$_});
        print "</td>\n</tr>\n";
        print "</td>\n</tr>\n";
      }
      elsif ($lc_fieldname eq "responsible")
      {
        print "<tr>\n<td><b>$_:</b>\n</td>\n<td>",
        $intro,
        $q->popup_menu(-name=>$_,
                       -values=>\@values,
                       -labels=>\%responsible_fullname,
                       -default=>$fields{$_});
        print "</td>\n</tr>\n";
      }
      else
      {  
        print "<tr>\n<td><b>$_:</b>\n</td>\n<td>",
        $intro,
        $q->popup_menu(-name=>$_,
                       -values=>\@$lc_fieldname,
                       -default=>$fields{$_});
        print "</td>\n</tr>\n";
      }
    }
    elsif ($fieldnames{$_} && ($fieldnames{$_} & $MULTILINE))
    {
      my $rows = 4;
      $rows = 8 if /Description/;
      $rows = 2 if /Environment/;
      print "<tr>\n<td valign=top><b>$_:</b></td>\n<td>",
            $intro,
            $q->textarea(-name=>$_,
                         -cols=>$textwidth,
                         -rows=>$rows,
                         -default=>$fields{$_});
      # Print attachments after Description.
      if (/Description/) {
        print "</td>\n</tr>\n";
        print_attachments(\%fields, 'edit');
      }
      print "</td>\n</tr>\n";
    }
    else
    {
      print "<tr>\n<td><b>$_:</b></td>\n<td>",
            $intro,
            $q->textfield(-name=>$_,
                          -size=>$textwidth,
                          -default=>$fields{$_});
      print "</td>\n</tr>\n";
    }
    if ($fieldnames{$_} && $fieldnames{$_} & $REASONCHANGE)
    {
      print "<tr>\n<td valign=top><b>Reason Changed:</b></td>\n<td>",
            $q->textarea(-name=>"$_-Why",
			 -default=>'',
			 -override=>1,
			 -cols=>$textwidth,
			 -rows=>2);
      print "</td>\n</tr>\n";
    }
    print "\n";
  }
  print	"</table>",
	$q->p($q->submit('cmd', 'submit edit'),
	" or ",
	$q->reset(-name=>'reset'),
        " or ",
        get_mailto_link($pr, %fields)),
	$q->end_form(),
	$q->hr();

  # Footer comes before the audit-trail.
  page_footer($page);

  print "<h3>Audit-Trail:</h3>\n",
        mark_urls($q->pre($q->escapeHTML($fields{'Audit-Trail'})));
  page_end_html($page);
}

# Print out the %fields hash for debugging.
sub debug_print_fields
{
  my $fields_hash_ref = shift;
  print "<table cellspacing=0 cellpadding=0 border=1>\n";
  foreach my $f (sort keys %$fields_hash_ref)
  {
    print "<tr valign=top><td>$f</td><td>",
          $q->pre($q->escapeHTML($$fields_hash_ref{$f})),
          "</td></tr>\n";
  }
  my $aref = $$fields_hash_ref{'attachments'} || [];
  my $i=0;
  foreach my $href (@$aref) {
    print "<tr valign=top><td>attachment $i</td><td>",
          ($$href{'original_attachment'}
           ?  $$href{'original_attachment'} : "--- empty ---"),
          "</td></tr>\n";
    $i++;
  }
  print "</table><hr>\n";
}

# submitedit -
#     User pressed 'submit' on the edit page.  If the edits are applied
#     successfully, give a message then return the user to the URL
#     specified in param('return_url') so that he can continue doing what
#     he was previously doing (e.g. looking at query results).  If the
#     edits are not successful, print and error and stay put.
#     
sub submitedit
{
  local($page) = 'Edit PR Results'; # local so visible to &$err_sub
  my $debug = 0;
  my $mail_sent = 0;

  # Local sub to report errors while editing.
  # This allows us to postpone calling print_header().
  my $err_sub = sub {
    my($err_heading, $err_text) = @_;
    print_header();
    page_start_html($page);
    page_heading($page, 'Error');
    print "<h3>$err_heading</h3>";
    print "<p>$err_text</p>" if $err_text;
    page_footer($page);
    page_end_html($page);
    return;
  };

  my($pr) = $q->param('pr');
  if(!$pr)
  {
    &$err_sub("You must specify a problem report number");
    return;
  }

  my(%fields, %mailto, $adr);
  my $audittrail = '';
  my $err = '';
  my $ok = 1;

  # Retrieve new attachment (if any) before locking PR, in case it fails.
  my $encoded_attachment = encode_attachment('attached_file');

  my(%oldfields) = lockpr($pr, $db_prefs{'user'});

  if ($gnats::ERRSTR) {
    &$err_sub("$gnats::ERRSTR", "The PR has not been changed. "
              . "If this problem persists, please contact a "
              . "GNATS administrator.");
    client_exit();
    exit();
  }

  LOCKED:
  {
    # Trim Responsible for compatibility.
    $oldfields{'Responsible'} = trim_responsible($oldfields{'Responsible'});

    # Merge %oldfields and CGI params to get %fields.  Not all gnats
    # fields have to be present in the CGI params; the ones which are
    # not specified default to their old values.
    %fields = %oldfields;
    foreach my $key ($q->param)
    {
      my $val = $q->param($key);
      if($key =~ /-Why/
         || ($fieldnames{$key} && ($fieldnames{$key} & $MULTILINE)))
      {
	$val = fix_multiline_val($val);
      }
      $fields{$key} = $val;
    }

    # Add the attached file, if any, to the new PR.
    add_encoded_attachment_to_pr(\%fields, $encoded_attachment);

    # Delete any attachments, if directed.
    my(@deleted_attachments) = $q->param('delete attachments');
    remove_attachments_from_pr(\%fields, @deleted_attachments);

    if($fields{'Last-Modified'} ne $oldfields{'Last-Modified'})
    {
      &$err_sub("PR $pr has been modified since you started editing it.",
                "Please return to the edit form, press the Reload button, "
                . "then make your edits again.\n"
                . "<pre>Last-Modified was    '$fields{'Last-Modified'}'\n"
                . "Last-Modified is now '$oldfields{'Last-Modified'}'</pre>\n");
      last LOCKED;
    }

    if($db_prefs{'user'} eq "" || $fields{'Responsible'} eq "")
    {
      &$err_sub("Can't make the edit",
                "Responsible is '$fields{'Responsible'}', user is '$db_prefs{'user'}'");
      last LOCKED;
    }

    # If X-GNATS-Notify or Reply-To changed, we need to splice the
    # change into the envelope.
    foreach ('Reply-To', 'X-GNATS-Notify')
    {
      if($fields{$_} ne $oldfields{$_})
      {
        if ($fields{'envelope'} =~ /^$_:/m)
        {
          # Replace existing header with new one.
          $fields{'envelope'} =~ s/^$_:.*$/$_: $fields{$_}/m;
        }
        else
        {
          # Insert new header at end (blank line).  Keep blank line at end.
          $fields{'envelope'} =~ s/^$/$_: $fields{$_}\n/m;
        }
      }
    }

    if ($debug)
    {
      &$err_sub("debugging -- PR edits not submitted");
      debug_print_fields(\%fields);
      last LOCKED;
    }

    # Leave an Audit-Trail
    foreach (@fieldnames)
    {
      if($_ ne "Audit-Trail")
      {
        $oldfields{$_} = '' if !defined($oldfields{$_}); # avoid -w warning
        $fields{$_} = '' if !defined($fields{$_}); # avoid -w warning
	if($fields{$_} ne $oldfields{$_})
	{
          next unless ($fieldnames{$_} & $AUDITINCLUDE);
	  if($fieldnames{$_} & $MULTILINE)
	  {
            # For multitext fields, indent the values.
            my $tmp = $oldfields{$_};
            $tmp =~ s/^/    /gm;
	    $audittrail .= "$_-Changed-From:\n$tmp";
            $tmp = $fields{$_};
            $tmp =~ s/^/    /gm;
	    $audittrail .= "$_-Changed-To:\n$tmp";
	  }
          else
          {
            $audittrail .= "$_-Changed-From-To: $oldfields{$_}->$fields{$_}\n";
	  }
	  $audittrail .= "$_-Changed-By: $db_prefs{'user'}\n";
	  $audittrail .= "$_-Changed-When: " . scalar(localtime()) . "\n";
	  if($fieldnames{$_} & $REASONCHANGE)
	  {
	    if($fields{"$_-Why"} =~ /^\s*$/)
	    {
              if ($ok) {
                $ok = 0;
                print_header();
                page_start_html($page);
                page_heading($page, 'Error');
              }
	      print "<h3>Field '$_' must have a reason for change</h3>",
                    "Old $_: $oldfields{$_}<br>",
                    "New $_: $fields{$_}";
	    }
            else
            {
              # Indent the "Why" value.
              my $tmp = $fields{"$_-Why"};
              $tmp =~ s/^/    /gm;
              $audittrail .= "$_-Changed-Why:\n" . $tmp;
            }
	  }
	}
      }
    }
    $fields{'Audit-Trail'} = $oldfields{'Audit-Trail'} . $audittrail;

    last LOCKED unless $ok;

    # Get list of people to notify, then add old responsible person.
    # If that person doesn't exist, don't worry about it.
    %mailto = interested_parties($pr, 0, %fields);
    if(defined($adr = praddr($oldfields{'Responsible'})))
    {
      $mailto{$adr} = 1;
    }

    my($newpr) = unparsepr('gnatsd', %fields);
    $newpr =~ s/\r//g;
    #print $q->pre($q->escapeHTML($newpr));
    #last LOCKED; # debug

    # Submit the edits.
    client_cmd("edit $fields{'Number'}");
    my $error = $gnats::ERRSTR;
    client_cmd("$newpr\n.");
    $error ||= $gnats::ERRSTR;

    if ($error) {
      my $page = 'Error';
      print_header();
      page_start_html($page);
      page_heading($page, $page);
      print $q->h2("$error");
      print $q->p("The PR has not been changed. "
              . "If this problem persists, please contact a "
              . "GNATS administrator.");
      last LOCKED;
    }

    # Now send mail to all concerned parties,
    # but only if there's something interesting to say.
    my($mailto);
    delete $mailto{''};
    $mailto = join(", ", sort(keys(%mailto)));
    #print $q->pre($q->escapeHTML("mailto->$mailto<-\n"));
    #last LOCKED; # debug
    if($mailto ne "" && $audittrail ne "")
    {
      # Use email address in responsible file as From, if present.
      my $from = $responsible_address{$db_prefs{'user'}} || $db_prefs{'user'};
      if(!open(MAILER, "|$site_mailer"))
      {
        &$err_sub("Edit successful, but email notification failed",
                  "Can't open pipe to $site_mailer: $!");
        last LOCKED;
      }
      else
      {
        print MAILER "To: $mailto\n";
        print MAILER "From: $from\n";
        print MAILER "Reply-To: $from, $mailto, $config{'GNATS_ADDR'}\n";
        print MAILER "X-Mailer: gnatsweb $VERSION\n";
        #GCC-LOCAL begin.
        #print MAILER "Subject: Re: $fields{'Category'}/$pr\n\n";
        print MAILER "Subject: Re: $fields{'Category'}/$pr: $fields{'Synopsis'}\n\n";
        #GCC-LOCAL end.
        if ($oldfields{'Synopsis'} eq $fields{'Synopsis'})
        {
          print MAILER "Synopsis: $fields{'Synopsis'}\n\n";
        }
        else
        {
          print MAILER "Old Synopsis: $oldfields{'Synopsis'}\n";
          print MAILER "New Synopsis: $fields{'Synopsis'}\n\n";
        }
        print MAILER "$audittrail\n";
        # Print URL so that HTML-enabled mail readers can jump to the PR.
        print MAILER get_viewpr_url($pr), "\n";
        if(!close(MAILER))
        {
          &$err_sub("Edit successful, but email notification failed",
                    "Can't close pipe to $site_mailer: $!");
          last LOCKED;
        }
        $mail_sent = 1;
      }
    }
    $lock_end_reached = 1;
  }
  unlockpr($fields{'Number'});

  if ($lock_end_reached) {
    # We print out the "Edit successful" message after unlocking the
    # PR. If the user hits the Stop button of the browser while
    # submitting, the web server won't terminate the script until the
    # next time the server attempts to output something to the
    # browser.  Since this is the first output after the PR was
    # locked, we print it after the unlocking.  Let user know the edit
    # was successful. After a 2s delay, refresh back to where the user
    # was before the edit. Internet Explorer does not honor the HTTP
    # Refresh header, so we have to complement the "clean" CGI.pm
    # method with the ugly hack below, with a HTTP-EQUIV in the HEAD
    # to make things work.
    my $return_url = $q->param('return_url') || get_script_name();
    my $refresh = 2;

    print_header(-Refresh => "$refresh; URL=$return_url",
                 -cookie => create_global_cookie());
    # Workaround for MSIE:
    my @args = (-title=>"$page - $site_banner_text");
    push(@args, -bgcolor=>$site_background)
          if defined($site_background);
    push(@args, -style=>{-src=>$site_stylesheet})
          if defined($site_stylesheet);
    push(@args, -head=>meta({-http_equiv=>'Refresh',
                             -content=>"$refresh; URL=$return_url"}));
    print $q->start_html(@args);
    
    # Print page banner, with button bar, without the <head> part:
    page_start_html($page, 0, 1);

    page_heading($page, ($mail_sent ? 'Edit successful; mail sent'
                         : 'Edit successful'));
    print "<p>Page will refresh in $refresh seconds...</p>\n";
  }

  page_footer($page);
  page_end_html($page);
}

sub query_page
{
  my $page = 'Query PR';
  page_start_html($page);
  page_heading($page, 'Query Problem Reports', 1);
  print_stored_queries();
  print $q->start_form(),
  hidden_db(),
  $q->submit('cmd', 'submit query'),
  "<hr>",
  "<table>\n",
  "<tr>\n<td>Category:</td>\n<td>",
  $q->popup_menu(-name=>'category',
                 -values=>\@category,
                 -labels=>\%category_desc,
                 -default=>$category[0]),
  "</td>\n</tr>\n<tr>\n<td>Severity:</td>\n<td>",
	$q->popup_menu(-name=>'severity',
	               -values=>\@severity,
		       -default=>$severity[0]),
	"</td>\n</tr>\n<tr>\n<td>Priority:</td>\n<td>",
	$q->popup_menu(-name=>'priority',
	               -values=>\@priority,
		       -default=>$priority[0]),
	"</td>\n</tr>\n<tr>\n<td>Responsible:</td>\n<td>",
	$q->popup_menu(-name=>'responsible',
		       -values=>\@responsible,
               -labels=>\%responsible_fullname,
		       -default=>$responsible[0]),
    "</td>\n</tr>\n<tr>\n<td>Submitter-ID:</td>\n<td>",
    $q->popup_menu(-name=>'submitter_id',
               -values=>\@submitter_id,
               -labels=>\%submitter_fullname,
               -default=>$submitter_id[0]),
	"</td>\n</tr>\n<tr>\n<td>State:</td>\n<td>",
	$q->popup_menu(-name=>'state',
		       -values=>\@state,
		       -default=>$state[0]),
	"</td>\n</tr>\n<tr>\n<td>\n</td>\n<td>",
	$q->checkbox_group(-name=>'ignoreclosed',
	               -values=>['Ignore Closed'],
		       -defaults=>['Ignore Closed']),
	"</td>\n</tr>\n<tr>\n<td>Class:</td>\n<td>",
	$q->popup_menu(-name=>'class',
		       -values=>\@class,
		       -default=>$class[0]),
	"</td>\n</tr>\n<tr>\n<td>Synopsis Search:</td>\n<td>",
	$q->textfield(-name=>'synopsis',-size=>25),
	"</td>\n</tr>\n<tr>\n<td>Multi-line Text Search:</td>\n<td>",
	$q->textfield(-name=>'multitext',-size=>25),
	"</td>\n</tr>\n<tr>\n<td>\n</td>\n<td>",
	$q->checkbox_group(-name=>'originatedbyme',
	               -values=>['Originated by You'],
		       -defaults=>[]),
	"</td>\n</tr>\n<tr valign=top>\n<td>Column Display:</td>\n<td>";
  my(@columns) = split(' ', $global_prefs{'columns'});
  @columns = @deffields unless @columns;
  print $q->scrolling_list(-name=>'columns',
                           -values=>\@fields,
                           -defaults=>\@columns,
                           -multiple=>1,
                           -size=>5),
	"</td>\n</tr>\n<tr>\n<td>\n</td>\n<td>",
    $q->checkbox_group(-name=>'displaydate',
                   -values=>['Display Current Date'],
               -defaults=>['Display Current Date']),
  "</td>\n</tr>\n</table>",
        "<hr>",
	$q->submit('cmd', 'submit query'),
        $q->end_form();

  page_footer($page);
  page_end_html($page);
}

sub advanced_query_page
{
  my $page = 'Advanced Query';
  page_start_html($page);
  page_heading($page, 'Query Problem Reports', 1);
  print_stored_queries();
  print $q->start_form(),
        hidden_db();

  my $width = 30;
  my $heading_bg = '#9fbdf9';
  my $cell_bg = '#d0d0d0';

  print $q->p($q->submit('cmd', 'submit query'),
	" or ",
	$q->reset(-name=>'reset'));
  print "<hr>";
  print "<center>";

  ### Text and multitext queries

  print "<table border=1 cellspacing=0 bgcolor=$cell_bg>",
        "<caption>Search All Text</caption>",
        "<tr bgcolor=$heading_bg>\n",
        "<th nowrap>Search these text fields</th>\n",
        "<th nowrap>using regular expression</th>\n",
        "</tr>\n";
  print "<tr>\n<td>Single-line text fields:</td>\n<td>",
        $q->textfield(-name=>'text', -size=>$width),
        "</td>\n</tr>\n",
        "<tr>\n<td>Multi-line text fields:</td>\n<td>",
        $q->textfield(-name=>'multitext', -size=>$width),
        "</td>\n</tr>\n",
        "</table>\n";

  print "<div>&nbsp;</div>\n";

  ### Date queries

  print "<table border=1 cellspacing=0 bgcolor=$cell_bg>",
        "<caption>Search By Date</caption>",
        "<tr bgcolor=$heading_bg>\n",
        "<th nowrap>Date Se…