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);
use Debbugs::Packages qw(:mapping);
use Debbugs::Text qw(:templates);
+use Encode qw(decode_utf8);
use POSIX qw(strftime);
@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());
spec => {binary => {type => BOOLEAN,
default => 1,
},
- package => {type => SCALAR|ARRAYREF,
+ package => {type => SCALAR,#|ARRAYREF,
},
options => {type => HASHREF,
},
bugs => {type => ARRAYREF,
},
+ schema => {type => OBJECT,
+ optional => 1,
+ },
},
);
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 {
- print {$output} "<p>No maintainer for $showpkg. Please do not report new bugs against this package.</p>\n";
- }
- my @pkgs = getsrcpkgs($srcforpkg);
+ 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 = 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;
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>";
}
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{package_tracking_domain} and
+ length $config{package_tracking_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) {
$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 (@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}");
- }
- 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>";
+ html_escape("$config{web_domain}/Reporting$config{html_suffix}");
}
- return $output_scalar;
+ return decode_utf8($output_scalar);
}
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 $s{"pending"} eq 'fixed' || 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 $s{"pending"} eq 'fixed' || length $s{done};
- push @{$status{blocks_array}}, {bug_num => $b, subject => $s{subject}, status => \%s};
- }
- }
-
-
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,
'&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;
}
sub pkg_htmlizebugs {
my %param = validate_with(params => \@_,
- spec => {bugs => {type => ARRAYREF,
+ spec => {bugs => {type => OBJECT,
},
names => {type => ARRAYREF,
},
options => {type => HASHREF,
default => {},
},
+ 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";
- my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay); #, $gHTMLExpireNote);
-
- 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 = (
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";
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 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 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"};
-
- 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;
+ my ($order,$bug) = @_;
+ my $pos = 0;
+ for my $el (@{$order}) {
+ if ($el->($bug)) {
+ 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 {
projects / debbugs.git / blobdiff