]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/CGI/Pkgreport.pm
pending is not a status field
[debbugs.git] / Debbugs / CGI / Pkgreport.pm
index 2d0de6f6c74803a704948c31e9fb7ba1961e34ce..28c1f75b4d6a63fbc7ff7dcac3ed5ef45daa037b 100644 (file)
@@ -28,11 +28,16 @@ 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);
 
+use Debbugs::Collection::Bug;
+
+use Carp;
+use List::AllUtils qw(apply);
+
 use Debbugs::Config qw(:config :globals);
 use Debbugs::CGI qw(:url :html :util);
 use Debbugs::Common qw(:misc :util :date);
@@ -41,7 +46,7 @@ use Debbugs::Bugs qw(bug_filter);
 use Debbugs::Packages qw(:mapping);
 
 use Debbugs::Text qw(:templates);
-use Encode qw(encode_utf8);
+use Encode qw(decode_utf8);
 
 use POSIX qw(strftime);
 
@@ -81,6 +86,9 @@ sub generate_package_info{
                                                    },
                                         bugs    => {type => ARRAYREF,
                                                    },
+                                        schema => {type => OBJECT,
+                                                   optional => 1,
+                                                  },
                                        },
                              );
 
@@ -91,19 +99,25 @@ sub generate_package_info{
 
      my %pkgsrc = %{getpkgsrc()};
      my $srcforpkg = $package;
-     if ($param{binary} and exists $pkgsrc{$package}
-        and defined $pkgsrc{$package}) {
-         $srcforpkg = $pkgsrc{$package};
+     if ($param{binary}) {
+        $srcforpkg =
+            binary_to_source(source_only => 1,
+                             scalar_only => 1,
+                             binary => $package,
+                             hash_slice(%param,qw(schema)),
+                            );
      }
 
      my $showpkg = html_escape($package);
-     my $maintainers = getmaintainers();
-     my $maint = $maintainers->{$srcforpkg};
-     if (defined $maint) {
+     my @maint = package_maintainer($param{binary}?'binary':'source',
+                                   $package,
+                                   hash_slice(%param,qw(schema)),
+                                  );
+     if (@maint) {
          print {$output} '<p>';
-         print {$output} (($maint =~ /,/)? "Maintainer for $showpkg is "
+         print {$output} (@maint > 1? "Maintainer for $showpkg is "
                           : "Maintainers for $showpkg are ") .
-                               package_links(maint => $maint);
+                               package_links(maintainer => \@maint);
          print {$output} ".</p>\n";
      }
      else {
@@ -111,7 +125,15 @@ sub generate_package_info{
               "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);
+     my @pkgs = source_to_binary(source => $srcforpkg,
+                                hash_slice(%param,qw(schema)),
+                                binary_only => 1,
+                                # if there are distributions, only bother to
+                                # show packages which are currently in a
+                                # distribution.
+                                @{$config{distributions}//[]} ?
+                                (dist => [@{$config{distributions}}]) : (),
+                               );
      @pkgs = grep( !/^\Q$package\E$/, @pkgs );
      if ( @pkgs ) {
          @pkgs = sort @pkgs;
@@ -128,27 +150,20 @@ 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://$config{web_domain}/pseudo-packages$config{html_suffix}\">".
+         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 $config{package_pages} and length $config{package_pages}) {
               push @references, sprintf "to the <a href=\"%s\">%s package page</a>",
-                   html_escape("http://$config{package_pages}/$package"), html_escape("$package");
+                   html_escape("$config{package_pages}/$package"), html_escape("$package");
          }
-         if (defined $config{subscription_domain} and
-             length $config{subscription_domain}) {
+         if (defined $config{package_tracking_domain} and
+             length $config{package_tracking_domain}) {
               my $ptslink = $param{binary} ? $srcforpkg : $package;
               # the pts only wants the source, and doesn't care about src: (#566089)
               $ptslink =~ s/^src://;
-              push @references, q(to the <a href="http://).html_escape("$config{subscription_domain}/$ptslink").q(">Package Tracking System</a>);
+              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) {
@@ -163,12 +178,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 $maint) {
+     if (@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://$config{web_domain}/Reporting$config{html_suffix}");
+              html_escape("$config{web_domain}/Reporting$config{html_suffix}");
      }
-     return encode_utf8($output_scalar);
+     return decode_utf8($output_scalar);
 }
 
 
@@ -200,52 +215,14 @@ display below
 
 sub short_bug_status_html {
      my %param = validate_with(params => \@_,
-                              spec   => {status => {type => HASHREF,
-                                                   },
-                                         options => {type => HASHREF,
-                                                     default => {},
-                                                    },
-                                         bug_options => {type => HASHREF,
-                                                         default => {},
-                                                        },
-                                         snippet => {type => SCALAR,
-                                                     default => '',
-                                                    },
+                              spec   => {bug => {type => OBJECT,
+                                                 isa => 'Debbugs::Bug',
+                                                },
                                         },
                              );
 
-     my %status = %{$param{status}};
-
-     $status{tags_array} = [sort(split(/\s+/, $status{tags}))];
-     $status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date}));
-     $status{mergedwith_array} = [split(/ /,$status{mergedwith})];
-
-     my @blockedby= split(/ /, $status{blockedby});
-     $status{blockedby_array} = [];
-     if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
-         for my $b (@blockedby) {
-              my %s = %{get_bug_status($b)};
-              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};
-         }
-     }
-
-     my @blocks= split(/ /, $status{blocks});
-     $status{blocks_array} = [];
-     if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
-         for my $b (@blocks) {
-              my %s = %{get_bug_status($b)};
-              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,
+                            variables => {bug => $param{bug},
                                           isstrongseverity => \&Debbugs::Status::isstrongseverity,
                                           html_escape   => \&Debbugs::CGI::html_escape,
                                           looks_like_number => \&Scalar::Util::looks_like_number,
@@ -263,7 +240,7 @@ sub short_bug_status_html {
 
 sub pkg_htmlizebugs {
      my %param = validate_with(params => \@_,
-                              spec   => {bugs => {type => ARRAYREF,
+                              spec   => {bugs => {type => OBJECT,
                                                  },
                                          names => {type => ARRAYREF,
                                                   },
@@ -301,25 +278,20 @@ sub pkg_htmlizebugs {
                                          dist     => {type => SCALAR,
                                                       optional => 1,
                                                      },
+                                         schema   => {type => OBJECT,
+                                                      optional => 1,
+                                                     },
                                         }
                              );
-     my @bugs = @{$param{bugs}};
-
-     my @status = ();
+     my $bugs = $param{bugs};
      my %count;
      my $header = '';
      my $footer = "<h2 class=\"outstanding\">Summary</h2>\n";
 
-     if (@bugs == 0) {
+     if ($bugs->count == 0) {
          return "<HR><H2>No reports found!</H2></HR>\n";
      }
 
-     if ( $param{bug_rev} ) {
-         @bugs = sort {$b<=>$a} @bugs;
-     }
-     else {
-         @bugs = sort {$a<=>$b} @bugs;
-     }
      my %seenmerged;
 
      my %common = (
@@ -350,50 +322,50 @@ sub pkg_htmlizebugs {
          push @{$exclude{$key}}, split /\s*,\s*/, $value;
      }
 
-     foreach my $bug (@bugs) {
-         my %status = %{get_bug_status(bug=>$bug,
-                                       (exists $param{dist}?(dist => $param{dist}):()),
-                                       bugusertags => $param{bugusertags},
-                                       (exists $param{version}?(version => $param{version}):()),
-                                       (exists $param{arch}?(arch => $param{arch}):(arch => $config{default_architectures})),
-                                      )};
-         next unless %status;
-         next if bug_filter(bug => $bug,
-                            status => \%status,
-                            repeat_merged => $param{repeatmerged},
-                            seen_merged => \%seenmerged,
-                            (keys %include ? (include => \%include):()),
-                            (keys %exclude ? (exclude => \%exclude):()),
-                           );
-
-         my $html = "<li>"; #<a href=\"%s\">#%d: %s</a>\n<br>",
-              #bug_url($bug), $bug, html_escape($status{subject});
-         $html .= short_bug_status_html(status  => \%status,
-                                        options => $param{options},
-                                       ) . "\n";
-         push @status, [ $bug, \%status, $html ];
+     my $sorter = sub {$_[0]->id <=> $_[1]->id};
+     if ($param{bug_rev}) {
+        $sorter = sub {$_[1]->id <=> $_[0]->id}
      }
-     if ($param{bug_order} eq 'age') {
-         # MWHAHAHAHA
-         @status = sort {$a->[1]{log_modified} <=> $b->[1]{log_modified}} @status;
+     elsif ($param{bug_order} eq 'age') {
+        $sorter = sub {$_[0]->modified->epoch <=> $_[1]->modified->epoch};
      }
      elsif ($param{bug_order} eq 'agerev') {
-         @status = sort {$b->[1]{log_modified} <=> $a->[1]{log_modified}} @status;
+        $sorter = sub {$_[1]->modified->epoch <=> $_[0]->modified->epoch};
      }
+     my @status;
+     for my $bug ($bugs->sort($sorter)) {
+        next if
+            $bug->filter(repeat_merged => $param{repeatmerged},
+                         seen_merged => \%seenmerged,
+                         (keys %include ? (include => \%include):()),
+                         (keys %exclude ? (exclude => \%exclude):()),
+                        );
+
+        my $html = "<li>";     #<a href=\"%s\">#%d: %s</a>\n<br>",
+        $html .= short_bug_status_html(bug => $bug,
+                                      ) . "\n";
+        push @status, [ $bug, $html ];
+     }
+     # parse bug order indexes into subroutines
+     my @order_subs =
+        map {
+            my $a = $_;
+            [map {parse_order_statement_to_subroutine($_)} @{$a}];
+        } @{$param{prior}};
      for my $entry (@status) {
          my $key = "";
-         for my $i (0..$#{$param{prior}}) {
-              my $v = get_bug_order_index($param{prior}[$i], $entry->[1]);
+         for my $i (0..$#order_subs) {
+              my $v = get_bug_order_index($order_subs[$i], $entry->[0]);
               $count{"g_${i}_${v}"}++;
               $key .= "_$v";
          }
-         $section{$key} .= $entry->[2];
+         $section{$key} .= $entry->[1];
          $count{"_$key"}++;
      }
 
      my $result = "";
      if ($param{ordering} eq "raw") {
-         $result .= "<UL class=\"bugs\">\n" . join("", map( { $_->[ 2 ] } @status ) ) . "</UL>\n";
+         $result .= "<UL class=\"bugs\">\n" . join("", map( { $_->[ 1 ] } @status ) ) . "</UL>\n";
      }
      else {
          $header .= "<div class=\"msgreceived\">\n<ul>\n";
@@ -459,6 +431,61 @@ sub pkg_htmlizebugs {
      return $result;
 }
 
+sub parse_order_statement_to_subroutine {
+    my ($statement) = @_;
+    if (not defined $statement or not length $statement) {
+       return sub {return 1};
+    }
+    croak "invalid statement '$statement'" unless
+       $statement =~ /^(?:(package|tag|pending|severity) # field
+                          = # equals
+                          ([^=|\&,\+]+(?:,[^=|\&,+])*) #value
+                          (\+|,|$) # joiner or end
+                      )+ # one or more of these statements
+                     /x;
+    my @sub_bits;
+    while ($statement =~ /(?<joiner>^|,|\+) # joiner
+                         (?<field>package|tag|pending|severity) # field
+                          = # equals
+                          (?<value>[^=|\&,\+]+(?:,[^=|\&,\+])*) #value
+                        /xg) {
+       my $field = $+{field};
+       my $value = $+{value};
+       my $joiner = $+{joiner} // '';
+       my @vals = apply {quotemeta($_)} split /,/,$value;
+       if (length $joiner) {
+           if ($joiner eq '+') {
+               push @sub_bits, ' and ';
+           }
+           else {
+               push @sub_bits, ' or ';
+           }
+       }
+       my @vals_bits;
+       for my $val (@vals) {
+           if ($field =~ /package|severity/o) {
+               push @vals_bits, '$_[0]->status->'.$field.
+                   ' eq q('.$val.')';
+           } elsif ($field eq 'tag') {
+               push @vals_bits, '$_[0]->tags->is_set('.
+                   'q('.$val.'))';
+           } elsif ($field eq 'pending') {
+               push @vals_bits, '$_[0]->'.$field.
+                   ' eq q('.$val.')';
+           }
+       }
+       push @sub_bits ,' ('.join(' or ',@vals_bits).') ';
+    }
+    # return a subroutine reference which determines whether an order statement
+    # matches this bug
+    my $sub = 'sub { return ('.join ("\n",@sub_bits).');};';
+    my $subref = eval $sub;
+    if ($@) {
+       croak "Unable to generate subroutine: $@; $sub";
+    }
+    return $subref;
+}
+
 sub parse_order_statement_into_boolean {
     my ($statement,$status,$tags) = @_;
 
@@ -495,19 +522,13 @@ sub parse_order_statement_into_boolean {
 }
 
 sub get_bug_order_index {
-     my $order = shift;
-     my $status = shift;
-     my $pos = 0;
-     my $tags = {map { $_, 1 } split / /, $status->{"tags"}
-                }
-         if defined $status->{"tags"};
-     for my $el (@${order}) {
-         if (not length $el or
-             parse_order_statement_into_boolean($el,$status,$tags)
-            ) {
-             return $pos;
-         }
-         $pos++;
+    my ($order,$bug) = @_;
+    my $pos = 0;
+    for my $el (@{$order}) {
+       if ($el->($bug)) {
+           return $pos;
+        }
+        $pos++;
      }
      return $pos;
 }