-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 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;