]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/CGI/Pkgreport.pm
Include the protocol (http://) in gWebDomain and gCGIDomain
[debbugs.git] / Debbugs / CGI / Pkgreport.pm
index 51ebe42266119cdb0cc5ae9dfb8c4bb133319ed5..4391197c59a82eb0e44357831f7dc89df697cd72 100644 (file)
@@ -28,7 +28,7 @@ None known.
 use warnings;
 use strict;
 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
 
 use IO::Scalar;
 use Params::Validate qw(validate_with :types);
@@ -41,6 +41,7 @@ use Debbugs::Bugs qw(bug_filter);
 use Debbugs::Packages qw(:mapping);
 
 use Debbugs::Text qw(:templates);
+use Encode qw(decode_utf8);
 
 use POSIX qw(strftime);
 
@@ -51,13 +52,9 @@ BEGIN{
 
      @EXPORT = ();
      %EXPORT_TAGS = (html => [qw(short_bug_status_html pkg_htmlizebugs),
-                             qw(pkg_javascript),
-                             qw(pkg_htmlselectyesno pkg_htmlselectsuite),
-                             qw(buglinklist pkg_htmlselectarch)
                             ],
-                    misc => [qw(generate_package_info make_order_list),
-                             qw(myurl),
-                             qw(get_bug_order_index determine_ordering),
+                    misc => [qw(generate_package_info),
+                             qw(determine_ordering),
                             ],
                    );
      @EXPORT_OK = (qw());
@@ -78,7 +75,7 @@ sub generate_package_info{
                               spec  => {binary => {type => BOOLEAN,
                                                    default => 1,
                                                   },
-                                        package => {type => SCALAR|ARRAYREF,
+                                        package => {type => SCALAR,#|ARRAYREF,
                                                    },
                                         options => {type => HASHREF,
                                                    },
@@ -110,7 +107,9 @@ sub generate_package_info{
          print {$output} ".</p>\n";
      }
      else {
-         print {$output} "<p>No maintainer for $showpkg. Please do not report new bugs against this package.</p>\n";
+         print {$output} "<p>There is no maintainer for $showpkg. ".
+              "This means that this package no longer exists (or never existed). ".
+                  "Please do not report new bugs against this package. </p>\n";
      }
      my @pkgs = getsrcpkgs($srcforpkg);
      @pkgs = grep( !/^\Q$package\E$/, @pkgs );
@@ -129,17 +128,27 @@ sub generate_package_info{
      my @references;
      my $pseudodesc = getpseudodesc();
      if ($package and defined($pseudodesc) and exists($pseudodesc->{$package})) {
-         push @references, "to the <a href=\"http://${debbugs::gWebDomain}/pseudo-packages${debbugs::gHTMLSuffix}\">".
+         push @references, "to the <a href=\"$config{web_domain}/pseudo-packages$config{html_suffix}\">".
               "list of other pseudo-packages</a>";
      }
+     elsif (not defined $maint and not @{$param{bugs}}) {
+       # don't bother printing out this information, because it's
+       # already present above.
+       #  print {$output} "<p>There is no record of the " . html_escape($package) .
+       #       ($param{binary} ? " package" : " source package") .
+       #           ", and no bugs have been filed against it.</p>";
+     }
      else {
-         if ($package and defined $gPackagePages) {
+         if ($package and defined $config{package_pages} and length $config{package_pages}) {
               push @references, sprintf "to the <a href=\"%s\">%s package page</a>",
-                   html_escape("http://${gPackagePages}/$package"), html_escape("$package");
+                   html_escape("$config{package_pages}/$package"), html_escape("$package");
          }
-         if (defined $gSubscriptionDomain) {
+         if (defined $config{subscription_domain} and
+             length $config{subscription_domain}) {
               my $ptslink = $param{binary} ? $srcforpkg : $package;
-              push @references, q(to the <a href="http://).html_escape("$gSubscriptionDomain/$ptslink").q(">Package Tracking System</a>);
+              # the pts only wants the source, and doesn't care about src: (#566089)
+              $ptslink =~ s/^src://;
+              push @references, q(to the <a href=").html_escape("$config{package_tracking_domain}/$ptslink").q(">Package Tracking System</a>);
          }
          # Only output this if the source listing is non-trivial.
          if ($param{binary} and $srcforpkg) {
@@ -154,17 +163,12 @@ sub generate_package_info{
          $references[$#references] = "or $references[$#references]" if @references > 1;
          print {$output} "<p>You might like to refer ", join(", ", @references), ".</p>\n";
      }
-     if (defined $param{maint} || defined $param{maintenc}) {
+     if (defined $maint) {
          print {$output} "<p>If you find a bug not listed here, please\n";
          printf {$output} "<a href=\"%s\">report it</a>.</p>\n",
-              html_escape("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}");
+              html_escape("$config{web_domain}/Reporting$config{html_suffix}");
      }
-     if (not $maint and not @{$param{bugs}}) {
-         print {$output} "<p>There is no record of the " . html_escape($package) .
-              ($param{binary} ? " package" : " source package") .
-                   ", and no bugs have been filed against it.</p>";
-     }
-     return $output_scalar;
+     return decode_utf8($output_scalar);
 }
 
 
@@ -221,7 +225,7 @@ sub short_bug_status_html {
      if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
          for my $b (@blockedby) {
               my %s = %{get_bug_status($b)};
-              next if $s{"pending"} eq 'fixed' || length $s{done};
+              next if (defined $s{pending} and $s{pending} eq 'fixed') or (defined $s{done} and length $s{done});
               push @{$status{blockedby_array}},{bug_num => $b, subject => $s{subject}, status => \%s};
          }
      }
@@ -231,12 +235,15 @@ sub short_bug_status_html {
      if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
          for my $b (@blocks) {
               my %s = %{get_bug_status($b)};
-              next if $s{"pending"} eq 'fixed' || length $s{done};
+              next if (defined $s{pending} and $s{pending} eq 'fixed') or (defined $s{done} and length $s{done});
               push @{$status{blocks_array}}, {bug_num => $b, subject => $s{subject}, status => \%s};
          }
      }
-
-
+     my $days = bug_archiveable(bug => $status{id},
+                               status => \%status,
+                               days_until => 1,
+                              );
+     $status{archive_days} = $days;
      return fill_in_template(template => 'cgi/short_bug_status',
                             variables => {status => \%status,
                                           isstrongseverity => \&Debbugs::Status::isstrongseverity,
@@ -248,121 +255,9 @@ sub short_bug_status_html {
                                           '&version_url'   => \&Debbugs::CGI::version_url,
                                           '&secs_to_english' => \&Debbugs::Common::secs_to_english,
                                           '&strftime'      => \&POSIX::strftime,
+                                          '&maybelink'     => \&Debbugs::CGI::maybelink,
                                          },
                            );
-
-     my $result = "";
-
-     my $showseverity;
-     if ($status{severity} eq 'normal') {
-         $showseverity = '';
-     }
-     elsif (isstrongseverity($status{severity})) {
-         $showseverity = "Severity: <em class=\"severity\">$status{severity}</em>;\n";
-     }
-     else {
-         $showseverity = "Severity: <em>$status{severity}</em>;\n";
-     }
-
-     $result .= package_links(package => $status{package},
-                             options  => $param{options},
-                            );
-
-     my $showversions = '';
-     if (@{$status{found_versions}}) {
-         my @found = @{$status{found_versions}};
-         $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @found;
-     }
-     if (@{$status{fixed_versions}}) {
-         $showversions .= '; ' if length $showversions;
-         $showversions .= '<strong>fixed</strong>: ';
-         my @fixed = @{$status{fixed_versions}};
-         $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @fixed;
-     }
-     $result .= ' (<a href="'.
-         version_url(package => $status{package},
-                     found   => $status{found_versions},
-                     fixed   => $status{fixed_versions},
-                    ).qq{">$showversions</a>)} if length $showversions;
-     $result .= ";\n";
-
-     $result .= $showseverity;
-     $result .= "Reported by: ".package_links(submitter=>$status{originator},
-                                             class => "submitter",
-                                            );
-     $result .= ";\nOwned by: " . package_links(owner => $status{owner},
-                                               class => "submitter",
-                                              )
-         if length $status{owner};
-     $result .= ";\nTags: <strong>"
-         . html_escape(join(", ", sort(split(/\s+/, $status{tags}))))
-              . "</strong>"
-                   if (length($status{tags}));
-
-     $result .= (length($status{mergedwith})?";\nMerged with ":"") .
-         bug_links(bug => [split(/ /,$status{mergedwith})],
-                   class => "submitter",
-                  );
-     $result .= (length($status{blockedby})?";\nBlocked by ":"") .
-         bug_links(bug => [split(/ /,$status{blockedby})],
-                   class => "submitter",
-                  );
-     $result .= (length($status{blocks})?";\nBlocks ":"") .
-         bug_links(bug => [split(/ /,$status{blocks})],
-                   class => "submitter",
-                  );
-
-     if (length($status{done})) {
-         $result .= "<br><strong>Done:</strong> " . html_escape($status{done});
-         my $days = bug_archiveable(bug => $status{id},
-                                    status => \%status,
-                                    days_until => 1,
-                                   );
-         if ($days >= 0 and defined $status{location} and $status{location} ne 'archive') {
-              $result .= ";\n<strong>Can be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
-         }
-         elsif (defined $status{location} and $status{location} eq 'archived') {
-              $result .= ";\n<strong>Archived.</strong>";
-         }
-     }
-
-     unless (length($status{done})) {
-         if (length($status{forwarded})) {
-              $result .= ";\n<strong>Forwarded</strong> to "
-                   . join(', ',
-                          map {maybelink($_)}
-                          split /\,\s+/,$status{forwarded}
-                         );
-         }
-         # Check the age of the logfile
-         my ($days_last,$eng_last) = secs_to_english(time - $status{log_modified});
-         my ($days,$eng) = secs_to_english(time - $status{date});
-
-         if ($days >= 7) {
-              my $font = "";
-              my $efont = "";
-              $font = "em" if ($days > 30);
-              $font = "strong" if ($days > 60);
-              $efont = "</$font>" if ($font);
-              $font = "<$font>" if ($font);
-
-              $result .= ";\n ${font}$eng old$efont";
-         }
-         if ($days_last > 7) {
-              my $font = "";
-              my $efont = "";
-              $font = "em" if ($days_last > 30);
-              $font = "strong" if ($days_last > 60);
-              $efont = "</$font>" if ($font);
-              $font = "<$font>" if ($font);
-
-              $result .= ";\n ${font}Modified $eng_last ago$efont";
-         }
-     }
-
-     $result .= ".";
-
-     return $result;
 }
 
 
@@ -403,6 +298,9 @@ sub pkg_htmlizebugs {
                                          options  => {type => HASHREF,
                                                       default => {},
                                                      },
+                                         dist     => {type => SCALAR,
+                                                      optional => 1,
+                                                     },
                                         }
                              );
      my @bugs = @{$param{bugs}};
@@ -412,8 +310,6 @@ sub pkg_htmlizebugs {
      my $header = '';
      my $footer = "<h2 class=\"outstanding\">Summary</h2>\n";
 
-     my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay);  #, $gHTMLExpireNote);
-
      if (@bugs == 0) {
          return "<HR><H2>No reports found!</H2></HR>\n";
      }
@@ -563,112 +459,59 @@ sub pkg_htmlizebugs {
      return $result;
 }
 
-sub pkg_javascript {
-     return fill_in_template(template=>'cgi/pkgreport_javascript',
-                           );
-}
-
-sub pkg_htmlselectyesno {
-     my ($name, $n, $y, $default) = @_;
-     return sprintf('<select name="%s"><option value=no%s>%s</option><option value=yes%s>%s</option></select>', $name, ($default ? "" : " selected"), $n, ($default ? " selected" : ""), $y);
-}
-
-sub pkg_htmlselectsuite {
-     my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
-     my @suites = ("stable", "testing", "unstable", "experimental");
-     my %suiteaka = ("stable", "etch", "testing", "lenny", "unstable", "sid");
-     my $defaultsuite = "unstable";
-
-     my $result = sprintf '<select name=dist id="%s">', $id;
-     for my $s (@suites) {
-         $result .= sprintf '<option value="%s"%s>%s%s</option>',
-              $s, ($defaultsuite eq $s ? " selected" : ""),
-                   $s, (defined $suiteaka{$s} ? " (" . $suiteaka{$s} . ")" : "");
-     }
-     $result .= '</select>';
-     return $result;
-}
-
-sub pkg_htmlselectarch {
-     my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
-     my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc);
-
-     my $result = sprintf '<select name=arch id="%s">', $id;
-     $result .= '<option value="any">any architecture</option>';
-     for my $a (@arches) {
-         $result .= sprintf '<option value="%s">%s</option>', $a, $a;
-     }
-     $result .= '</select>';
-     return $result;
-}
-
-sub myurl {
-     my %param = @_;
-     return html_escape(pkg_url(map {exists $param{$_}?($_,$param{$_}):()}
-                               qw(archive repeatmerged mindays maxdays),
-                               qw(version dist arch package src tag maint submitter)
-                              )
-                      );
-}
-
-sub make_order_list {
-     my $vfull = shift;
-     my @x = ();
-
-     if ($vfull =~ m/^([^:]+):(.*)$/) {
-         my $v = $1;
-         for my $vv (split /,/, $2) {
-              push @x, "$v=$vv";
-         }
-     }
-     else {
-         for my $v (split /,/, $vfull) {
-              next unless $v =~ m/.=./;
-              push @x, $v;
-         }
-     }
-     push @x, "";              # catch all
-     return @x;
+sub parse_order_statement_into_boolean {
+    my ($statement,$status,$tags) = @_;
+
+    if (not defined $tags) {
+        $tags = {map { $_, 1 } split / /, $status->{"tags"}
+                }
+            if defined $status->{"tags"};
+
+    }
+    # replace all + with &&
+    $statement =~ s/\+/&&/g;
+    # replace all , with ||
+    $statement =~ s/,/||/g;
+    $statement =~ s{([^\&\|\=]+) # field
+                    =
+                    ([^\&\|\=]+) # value
+              }{
+                  my $ok = 0;
+                  if ($1 eq 'tag') {
+                      $ok = 1 if defined $tags->{$2};
+                  } else {
+                      $ok = 1 if defined $status->{$1} and
+                          $status->{$1} eq $2;
+                  }
+                  $ok;
+              }exg;
+    # check that the parsed statement is just valid boolean statements
+    if ($statement =~ /^([01\(\)\&\|]+)$/) {
+        return eval "$1";
+    } else {
+        # this is an invalid boolean statement
+        return 0;
+    }
 }
 
 sub get_bug_order_index {
      my $order = shift;
      my $status = shift;
-     my $pos = -1;
-
-     my %tags = ();
-     %tags = map { $_, 1 } split / /, $status->{"tags"}
-         if defined $status->{"tags"};
-
+     my $pos = 0;
+     my $tags = {map { $_, 1 } split / /, $status->{"tags"}
+                }
+         if defined $status->{"tags"};
      for my $el (@${order}) {
-         $pos++;
-         my $match = 1;
-         for my $item (split /[+]/, $el) {
-              my ($f, $v) = split /=/, $item, 2;
-              next unless (defined $f and defined $v);
-              my $isokay = 0;
-              $isokay = 1 if (defined $status->{$f} and $v eq $status->{$f});
-              $isokay = 1 if ($f eq "tag" && defined $tags{$v});
-              unless ($isokay) {
-                   $match = 0;
-                   last;
-              }
-         }
-         if ($match) {
-              return $pos;
-              last;
-         }
-     }
-     return $pos + 1;
+         if (not length $el or
+             parse_order_statement_into_boolean($el,$status,$tags)
+            ) {
+             return $pos;
+         }
+         $pos++;
+     }
+     return $pos;
 }
 
-sub buglinklist {
-     my ($prefix, $infix, @els) = @_;
-     return '' if not @els;
-     return $prefix . bug_linklist($infix,'submitter',@els);
-}
-
-
 # sets: my @names; my @prior; my @title; my @order;
 
 sub determine_ordering {