cgi/pkgreport.cgi

   1 #!/usr/bin/perl -wT
   2
   3 package debbugs;
   4
   5 use strict;
   6 use POSIX qw(strftime nice);
   7
   8 require './common.pl';
   9
  10 use Debbugs::Config qw(:globals :text);
  11 use Debbugs::User;
  12 use Debbugs::CGI qw(version_url);
  13 use Debbugs::Common qw(getparsedaddrs :date);
  14 use Debbugs::Bugs qw(get_bugs);
  15
  16 use vars qw($gPackagePages $gWebDomain %gSeverityDisplay @gSeverityList);
  17
  18 if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') {
  19     print "Content-Type: text/html; charset=utf-8\n\n";
  20     exit 0;
  21 }
  22
  23 nice(5);
  24
  25 my $userAgent = detect_user_agent();
  26 my %param = readparse();
  27
  28 my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes";
  29 my $archive = ($param{'archive'} || "no") eq "yes";
  30 my $include = $param{'&include'} || $param{'include'} || "";
  31 my $exclude = $param{'&exclude'} || $param{'exclude'} || "";
  32
  33 my $users = $param{'users'} || "";
  34
  35 my $ordering = $param{'ordering'};
  36 my $raw_sort = ($param{'raw'} || "no") eq "yes";
  37 my $old_view = ($param{'oldview'} || "no") eq "yes";
  38 my $age_sort = ($param{'age'} || "no") eq "yes";
  39 unless (defined $ordering) {
  40    $ordering = "normal";
  41    $ordering = "oldview" if $old_view;
  42    $ordering = "raw" if $raw_sort;
  43    $ordering = 'age' if $age_sort;
  44 }
  45 my ($bug_order) = $ordering =~ /(age(?:rev)?)/;
  46 $bug_order = '' if not defined $bug_order;
  47
  48 my $bug_rev = ($param{'bug-rev'} || "no") eq "yes";
  49 my $pend_rev = ($param{'pend-rev'} || "no") eq "yes";
  50 my $sev_rev = ($param{'sev-rev'} || "no") eq "yes";
  51 my $pend_exc = $param{'&pend-exc'} || $param{'pend-exc'} || "";
  52 my $pend_inc = $param{'&pend-inc'} || $param{'pend-inc'} || "";
  53 my $sev_exc = $param{'&sev-exc'} || $param{'sev-exc'} || "";
  54 my $sev_inc = $param{'&sev-inc'} || $param{'sev-inc'} || "";
  55 my $maxdays = ($param{'maxdays'} || -1);
  56 my $mindays = ($param{'mindays'} || 0);
  57 my $version = $param{'version'} || undef;
  58 my $dist = $param{'dist'} || undef;
  59 my $arch = $param{'arch'} || undef;
  60 my $show_list_header = ($param{'show_list_header'} || $userAgent->{'show_list_header'} || "yes" ) eq "yes";
  61 my $show_list_footer = ($param{'show_list_footer'} || $userAgent->{'show_list_footer'} || "yes" ) eq "yes";
  62
  63 {
  64     if (defined $param{'vt'}) {
  65         my $vt = $param{'vt'};
  66         if ($vt eq "none") { $dist = undef; $arch = undef; $version = undef; }
  67         if ($vt eq "bysuite") {
  68             $version = undef;
  69             $arch = undef if ($arch eq "any");
  70         }
  71         if ($vt eq "bypkg" || $vt eq "bysrc") { $dist = undef; $arch = undef; }
  72     }
  73     if (defined $param{'includesubj'}) {
  74         my $is = $param{'includesubj'};
  75         $include .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $is));
  76     }
  77     if (defined $param{'excludesubj'}) {
  78         my $es = $param{'excludesubj'};
  79         $exclude .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $es));
  80     }
  81 }
  82
  83
  84 my %hidden = map { $_, 1 } qw(status severity classification);
  85 my %cats = (
  86     "status" => [ {
  87         "nam" => "Status",
  88         "pri" => [map { "pending=$_" }
  89             qw(pending forwarded pending-fixed fixed done absent)],
  90         "ttl" => ["Outstanding","Forwarded","Pending Upload",
  91                   "Fixed in NMU","Resolved","From other Branch"],
  92         "def" => "Unknown Pending Status",
  93         "ord" => [0,1,2,3,4,5,6],
  94     } ],
  95     "severity" => [ {
  96         "nam" => "Severity",
  97         "pri" => [map { "severity=$_" } @gSeverityList],
  98         "ttl" => [map { $gSeverityDisplay{$_} } @gSeverityList],
  99         "def" => "Unknown Severity",
 100         "ord" => [0..@gSeverityList],
 101     } ],
 102     "classification" => [ {
 103         "nam" => "Classification",
 104         "pri" => [qw(pending=pending+tag=wontfix
 105                      pending=pending+tag=moreinfo
 106                      pending=pending+tag=patch
 107                      pending=pending+tag=confirmed
 108                      pending=pending)],
 109         "ttl" => ["Will Not Fix","More information needed",
 110                   "Patch Available","Confirmed"],
 111         "def" => "Unclassified",
 112         "ord" => [2,3,4,1,0,5],
 113     } ],
 114     "oldview" => [ qw(status severity) ],
 115     "normal" => [ qw(status severity classification) ],
 116 );
 117
 118 my ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status, $tag, $usertag,
 119     $owner,
 120    );
 121
 122 my %which = (
 123         'pkg' => \$pkg,
 124         'src' => \$src,
 125         'maint' => \$maint,
 126         'maintenc' => \$maintenc,
 127         'submitter' => \$submitter,
 128         'severity' => \$severity,
 129         'tag' => \$tag,
 130         'usertag' => \$usertag,
 131         'owner'   => \$owner,
 132         );
 133 my @allowedEmpty = ( 'maint' );
 134
 135 my $found;
 136 foreach ( keys %which ) {
 137         $status = $param{'status'} || 'open' if /^severity$/;
 138         if (($found = $param{$_})) {
 139                 ${ $which{$_} } = $found;
 140                 last;
 141         }
 142 }
 143 if (!$found && !$archive) {
 144         foreach ( @allowedEmpty ) {
 145                 if (exists($param{$_})) {
 146                         ${ $which{$_} } = '';
 147                         $found = 1;
 148                         last;
 149                 }
 150         }
 151 }
 152 if (!$found) {
 153         my $which;
 154         if (($which = $param{'which'})) {
 155                 if (grep( /^\Q$which\E$/, @allowedEmpty)) {
 156                         ${ $which{$which} } = $param{'data'};
 157                         $found = 1;
 158                 } elsif (($found = $param{'data'})) {
 159                         ${ $which{$which} } = $found if (exists($which{$which}));
 160                 }
 161         }
 162 }
 163 quitcgi("You have to choose something to select by") if (!$found);
 164
 165 my %bugusertags;
 166 my %ut;
 167 for my $user (split /[\s*,]+/, $users) {
 168     next unless length($user) >= 4;
 169     add_user($user);
 170 }
 171
 172 if (defined $usertag) {
 173     my %select_ut = ();
 174     my ($u, $t) = split /:/, $usertag, 2;
 175     Debbugs::User::read_usertags(\%select_ut, $u);
 176     unless (defined $t && $t ne "") {
 177         $t = join(",", keys(%select_ut));
 178     }
 179
 180     add_user($u);
 181     $tag = $t;
 182 }
 183
 184 my $Archived = $archive ? " Archived" : "";
 185
 186 my $this = "";
 187
 188 my %indexentry;
 189 my %strings = ();
 190
 191 my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
 192 my $tail_html = $debbugs::gHTMLTail;
 193 $tail_html = $debbugs::gHTMLTail;
 194 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
 195
 196 set_option("repeatmerged", $repeatmerged);
 197 set_option("archive", $archive);
 198 set_option("include", $include);
 199 set_option("exclude", $exclude);
 200 set_option("pend-exc", $pend_exc);
 201 set_option("pend-inc", $pend_inc);
 202 set_option("sev-exc", $sev_exc);
 203 set_option("sev-inc", $sev_inc);
 204 set_option("maxdays", $maxdays);
 205 set_option("mindays", $mindays);
 206 set_option("version", $version);
 207 set_option("dist", $dist);
 208 set_option("arch", $arch);
 209 set_option("use-bug-idx", defined($param{'use-bug-idx'}) ? $param{'use-bug-idx'} : 0);
 210 set_option("show_list_header", $show_list_header);
 211 set_option("show_list_footer", $show_list_footer);
 212
 213 our %seen_users;
 214 sub add_user {
 215     my $ut = \%ut;
 216     my $u = shift;
 217
 218     return if $seen_users{$u};
 219     $seen_users{$u} = 1;
 220
 221     my $user = Debbugs::User::get_user($u);
 222
 223     my %vis = map { $_, 1 } @{$user->{"visible_cats"}};
 224     for my $c (keys %{$user->{"categories"}}) {
 225         $cats{$c} = $user->{"categories"}->{$c};
 226         $hidden{$c} = 1 unless defined $vis{$c};
 227     }
 228
 229     for my $t (keys %{$user->{"tags"}}) {
 230         $ut->{$t} = [] unless defined $ut->{$t};
 231         push @{$ut->{$t}}, @{$user->{"tags"}->{$t}};
 232     }
 233
 234     %bugusertags = ();
 235     for my $t (keys %{$ut}) {
 236         for my $b (@{$ut->{$t}}) {
 237             $bugusertags{$b} = [] unless defined $bugusertags{$b};
 238             push @{$bugusertags{$b}}, $t;
 239         }
 240     }
 241     set_option("bugusertags", \%bugusertags);
 242 }
 243
 244 my $pseudodesc = getpseudodesc();
 245 if (defined $pseudodesc and defined $pkg and exists $pseudodesc->{$pkg}) {
 246      undef $dist;
 247      set_option('dist',$dist)
 248 }
 249 my $title;
 250 my @bugs;
 251 if (defined $pkg) {
 252   $title = "package $pkg";
 253   add_user("$pkg\@packages.debian.org");
 254   # figure out the source package
 255   my $pkgsrc = getpkgsrc();
 256   add_user($pkgsrc->{$pkg}.'@packages.debian.org')
 257        if defined $pkgsrc->{$pkg};
 258   if (defined $version) {
 259     $title .= " (version $version)";
 260   } elsif (defined $dist) {
 261     $title .= " in $dist";
 262     my $verdesc = getversiondesc($pkg);
 263     $title .= " ($verdesc)" if defined $verdesc;
 264   }
 265   my @pkgs = split /,/, $pkg;
 266   @bugs = get_bugs(package=>\@pkgs,
 267                    archive=>$archive
 268                   );
 269 } elsif (defined $src) {
 270   add_user("$src\@packages.debian.org");
 271   $title = "source $src";
 272   set_option('arch', 'source');
 273   if (defined $version) {
 274     $title .= " (version $version)";
 275   } elsif (defined $dist) {
 276     $title .= " in $dist";
 277     my $verdesc = getversiondesc($src);
 278     $title .= " ($verdesc)" if defined $verdesc;
 279   }
 280   @bugs = get_bugs(src=>[split /,/, $src],
 281                    archive=>$archive
 282                   );
 283 } elsif (defined $maint) {
 284   add_user($maint);
 285   $title = "maintainer $maint";
 286   $title .= " in $dist" if defined $dist;
 287   if ($maint eq "") {
 288        my %maintainers = %{getmaintainers()};
 289        @bugs = @{getbugs(sub {my %d=@_;
 290                               foreach my $try (splitpackages($d{"pkg"})) {
 291                                    return 1 if !getparsedaddrs($maintainers{$try});
 292                               }
 293                               return 0;
 294                          })};
 295   } else {
 296        @bugs = get_bugs(maint=>[map {lc ($_)} split /,/,$maint],
 297                         archive=>$archive
 298                        );
 299   }
 300 } elsif (defined $maintenc) {
 301   my %maintainers = %{getmaintainers()};
 302   $title = "encoded maintainer $maintenc";
 303   $title .= " in $dist" if defined $dist;
 304   @bugs = @{getbugs(sub {my %d=@_;
 305                          foreach my $try (splitpackages($d{"pkg"})) {
 306                            my @me = getparsedaddrs($maintainers{$try});
 307                            return 1 if grep {
 308                              maintencoded($_->address) eq $maintenc
 309                            } @me;
 310                          }
 311                          return 0;
 312                         })};
 313 } elsif (defined $submitter) {
 314   add_user($submitter);
 315   $title = "submitter $submitter";
 316   $title .= " in $dist" if defined $dist;
 317   my @submitters = map {lc ($_)} split /,/, $submitter;
 318   @bugs = get_bugs(submitter => \@submitters,
 319                    archive=>$archive
 320                   );
 321 } elsif (defined($severity) && defined($status)) {
 322   $title = "$status $severity bugs";
 323   $title .= " in $dist" if defined $dist;
 324   my @severities = split /,/, $severity;
 325   my @statuses = split /,/, $status;
 326   @bugs = @{getbugs(sub {my %d=@_;
 327                        return (grep($d{"severity"} eq $_, @severities))
 328                          && (grep($d{"status"} eq $_, @statuses));
 329                      })};
 330 } elsif (defined($severity)) {
 331   $title = "$severity bugs";
 332   $title .= " in $dist" if defined $dist;
 333   my @severities = split /,/, $severity;
 334   @bugs = @{getbugs(sub {my %d=@_;
 335                        return (grep($d{"severity"} eq $_, @severities));
 336                      }, 'severity', @severities)};
 337 } elsif (defined($tag)) {
 338   $title = "bugs tagged $tag";
 339   $title .= " in $dist" if defined $dist;
 340   my @tags = split /,/, $tag;
 341   my %bugs = ();
 342   for my $t (@tags) {
 343       for my $b (@{$ut{$t}}) {
 344           $bugs{$b} = 1;
 345        }
 346   }
 347   @bugs = @{getbugs(sub {my %d = @_;
 348                          return 1 if $bugs{$d{"bug"}};
 349                          my %tags = map { $_ => 1 } split ' ', $d{"tags"};
 350                          return grep(exists $tags{$_}, @tags);
 351                         })};
 352 }
 353 elsif (defined $owner) {
 354      $title = "bugs owned by $owner";
 355      $title .= " in $dist" if defined $dist;
 356      my @owners = map {lc ($_)} split /,/, $owner;
 357      my %bugs = ();
 358      @bugs = get_bugs(owner=>\@owners,
 359                       archive=>$archive
 360                      );
 361
 362 }
 363 $title = htmlsanit($title);
 364
 365 my @names; my @prior; my @title; my @order;
 366 determine_ordering();
 367
 368 # strip out duplicate bugs
 369 my %bugs;
 370 @bugs{@bugs} = @bugs;
 371 @bugs = keys %bugs;
 372
 373 my $result = pkg_htmlizebugs(\@bugs);
 374
 375 print "Content-Type: text/html; charset=utf-8\n\n";
 376
 377 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
 378 print "<HTML><HEAD>\n" .
 379     "<TITLE>$title -- $gProject$Archived $gBug report logs</TITLE>\n" .
 380     qq(<link rel="stylesheet" href="$gWebHostBugDir/css/bugs.css" type="text/css">) .
 381     "</HEAD>\n" .
 382     '<BODY onload="pagemain();">' .
 383     "\n";
 384 print "<H1>" . "$gProject$Archived $gBug report logs: $title" .
 385       "</H1>\n";
 386
 387 my $showresult = 1;
 388
 389 if (defined $pkg || defined $src) {
 390     my $showpkg = htmlsanit((defined $pkg) ? $pkg : "source package $src");
 391     my %maintainers = %{getmaintainers()};
 392     my $maint = $pkg ? $maintainers{$pkg} : $maintainers{$src} ? $maintainers{$src} : undef;
 393     if (defined $maint) {
 394         print '<p>';
 395         print htmlmaintlinks(sub { $_[0] == 1 ? "Maintainer for $showpkg is "
 396                                               : "Maintainers for $showpkg are "
 397                                  },
 398                              $maint);
 399         print ".</p>\n";
 400     } else {
 401         print "<p>No maintainer for $showpkg. Please do not report new bugs against this package.</p>\n";
 402     }
 403     if (defined $maint or @bugs) {
 404         my %pkgsrc = %{getpkgsrc()};
 405         my $srcforpkg;
 406         if (defined $pkg) {
 407             $srcforpkg = $pkgsrc{$pkg};
 408             defined $srcforpkg or $srcforpkg = $pkg;
 409         }
 410         my @pkgs = getsrcpkgs($pkg ? $srcforpkg : $src);
 411         undef $srcforpkg unless @pkgs;
 412         @pkgs = grep( !/^\Q$pkg\E$/, @pkgs ) if ( $pkg );
 413         if ( @pkgs ) {
 414             @pkgs = sort @pkgs;
 415             if ($pkg) {
 416                     print "<p>You may want to refer to the following packages that are part of the same source:\n";
 417             } else {
 418                     print "<p>You may want to refer to the following individual bug pages:\n";
 419             }
 420             push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) );
 421             print join( ", ", map( "<A href=\"" . pkgurl($_) . "\">$_</A>", @pkgs ) );
 422             print ".\n";
 423         }
 424         my @references;
 425         my $pseudodesc = getpseudodesc();
 426         if ($pkg and defined($pseudodesc) and exists($pseudodesc->{$pkg})) {
 427             push @references, "to the <a href=\"http://${debbugs::gWebDomain}/pseudo-packages${debbugs::gHTMLSuffix}\">list of other pseudo-packages</a>";
 428         } else {
 429             if ($pkg and defined $gPackagePages) {
 430                 push @references, sprintf "to the <a href=\"%s\">%s package page</a>", urlsanit("http://${debbugs::gPackagePages}/$pkg"), htmlsanit("$pkg");
 431             }
 432             if (defined $gSubscriptionDomain) {
 433                 my $ptslink = $pkg ? $srcforpkg : $src;
 434                 push @references, "to the <a href=\"http://$gSubscriptionDomain/$ptslink\">Package Tracking System</a>";
 435             }
 436             # Only output this if the source listing is non-trivial.
 437             if ($pkg and $srcforpkg and (@pkgs or $pkg ne $srcforpkg)) {
 438                 push @references, sprintf "to the source package <a href=\"%s\">%s</a>'s bug page", srcurl($srcforpkg), htmlsanit($srcforpkg);
 439             }
 440         }
 441         if (@references) {
 442             $references[$#references] = "or $references[$#references]" if @references > 1;
 443             print "<p>You might like to refer ", join(", ", @references), ".</p>\n";
 444         }
 445         if (defined $maint || defined $maintenc) {
 446              print "<p>If you find a bug not listed here, please\n";
 447              printf "<a href=\"%s\">report it</a>.</p>\n",
 448                   urlsanit("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}");
 449         }
 450     } else {
 451         print "<p>There is no record of the " .
 452               (defined($pkg) ? htmlsanit($pkg) . " package"
 453                              : htmlsanit($src) . " source package") .
 454               ", and no bugs have been filed against it.</p>";
 455         $showresult = 0;
 456     }
 457 } elsif (defined $maint || defined $maintenc) {
 458     print "<p>Note that maintainers may use different Maintainer fields for\n";
 459     print "different packages, so there may be other reports filed under\n";
 460     print "different addresses.\n";
 461 } elsif (defined $submitter) {
 462     print "<p>Note that people may use different email accounts for\n";
 463     print "different bugs, so there may be other reports filed under\n";
 464     print "different addresses.\n";
 465 }
 466
 467 set_option("archive", !$archive);
 468 printf "<p>See the <a href=\"%s\">%s reports</a></p>",
 469      urlsanit(pkg_url((
 470                        map {
 471                             $_ eq 'archive'?():($_,$param{$_})
 472                        } keys %param
 473                       ),
 474                       ('archive',($archive?"no":"yes"))
 475                      )
 476              ), ($archive ? "active" : "archived");
 477 set_option("archive", $archive);
 478
 479 print $result if $showresult;
 480
 481 print pkg_javascript() . "\n";
 482 print "<h2 class=\"outstanding\"><a class=\"options\" href=\"javascript:toggle(1)\">Options</a></h2>\n";
 483 print "<div id=\"a_1\">\n";
 484 printf "<form action=\"%s\" method=POST>\n", myurl();
 485
 486 print "<table class=\"forms\">\n";
 487
 488 my ($checked_any, $checked_sui, $checked_ver) = ("", "", "");
 489 if (defined $dist) {
 490   $checked_sui = "CHECKED";
 491 } elsif (defined $version) {
 492   $checked_ver = "CHECKED";
 493 } else {
 494   $checked_any = "CHECKED";
 495 }
 496
 497 print "<tr><td>Show bugs applicable to</td>\n";
 498 print "    <td><input id=\"b_1_1\" name=vt value=none type=radio onchange=\"enable(1);\" $checked_any>anything</td></tr>\n";
 499 print "<tr><td></td>";
 500 print "    <td><input id=\"b_1_2\" name=vt value=bysuite type=radio onchange=\"enable(1);\" $checked_sui>" . pkg_htmlselectsuite(1,2,1) . " for " . pkg_htmlselectarch(1,2,2) . "</td></tr>\n";
 501
 502 if (defined $pkg) {
 503     my $v = htmlsanit($version) || "";
 504     my $pkgsane = htmlsanit($pkg);
 505     print "<tr><td></td>";
 506     print "    <td><input id=\"b_1_3\" name=vt value=bypkg type=radio onchange=\"enable(1);\" $checked_ver>$pkgsane version <input id=\"b_1_3_1\" name=version value=\"$v\"></td></tr>\n";
 507 } elsif (defined $src) {
 508     my $v = htmlsanit($version) || "";
 509     my $srcsane = htmlsanit($src);
 510     print "<tr><td></td>";
 511     print "    <td><input name=vt value=bysrc type=radio onchange=\"enable(1);\" $checked_ver>$srcsane version <input id=\"b_1_3_1\" name=version value=\"$v\"></td></tr>\n";
 512 }
 513 print "<tr><td>&nbsp;</td></tr>\n";
 514
 515 my $includetags = htmlsanit(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include));
 516 my $excludetags = htmlsanit(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude));
 517 my $includesubj = htmlsanit(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include));
 518 my $excludesubj = htmlsanit(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude));
 519 my $vismindays = ($mindays == 0 ? "" : $mindays);
 520 my $vismaxdays = ($maxdays == -1 ? "" : $maxdays);
 521
 522 my $sel_rmy = ($repeatmerged ? " selected" : "");
 523 my $sel_rmn = ($repeatmerged ? "" : " selected");
 524 my $sel_ordraw = ($ordering eq "raw" ? " selected" : "");
 525 my $sel_ordold = ($ordering eq "oldview" ? " selected" : "");
 526 my $sel_ordnor = ($ordering eq "normal" ? " selected" : "");
 527 my $sel_ordage = ($ordering eq "age" ? " selected" : "");
 528
 529 my $chk_bugrev = ($bug_rev ? " checked" : "");
 530 my $chk_pendrev = ($pend_rev ? " checked" : "");
 531 my $chk_sevrev = ($sev_rev ? " checked" : "");
 532
 533 print <<EOF;
 534 <tr><td>Only include bugs tagged with </td><td><input name=include value="$includetags"> or that have <input name=includesubj value="$includesubj"> in their subject</td></tr>
 535 <tr><td>Exclude bugs tagged with </td><td><input name=exclude value="$excludetags"> or that have <input name=excludesubj value="$excludesubj"> in their subject</td></tr>
 536 <tr><td>Only show bugs older than</td><td><input name=mindays value="$vismindays" size=5> days, and younger than <input name=maxdays value="$vismaxdays" size=5> days</td></tr>
 537
 538 <tr><td>&nbsp;</td></tr>
 539
 540 </td></tr>
 541 <tr><td>Merged bugs should be</td><td>
 542 <select name=repeatmerged>
 543 <option value=yes$sel_rmy>displayed separately</option>
 544 <option value=no$sel_rmn>combined</option>
 545 </select>
 546 <tr><td>Categorise bugs by</td><td>
 547 <select name=ordering>
 548 <option value=raw$sel_ordraw>bug number only</option>
 549 <option value=old$sel_ordold>status and severity</option>
 550 <option value=normal$sel_ordnor>status, severity and classification</option>
 551 <option value=age$sel_ordage>status, severity, classification, and age</option>
 552 EOF
 553
 554 {
 555 my $any = 0;
 556 my $o = $param{"ordering"} || "";
 557 for my $n (keys %cats) {
 558     next if ($n eq "normal" || $n eq "oldview");
 559     next if defined $hidden{$n};
 560     unless ($any) {
 561         $any = 1;
 562         print "<option disabled>------</option>\n";
 563     }
 564     my @names = map { ref($_) eq "HASH" ? $_->{"nam"} : $_ } @{$cats{$n}};
 565     my $name;
 566     if (@names == 1) { $name = $names[0]; }
 567     else { $name = " and " . pop(@names); $name = join(", ", @names) . $name; }
 568
 569     printf "<option value=\"%s\"%s>%s</option>\n",
 570         $n, ($o eq $n ? " selected" : ""), $name;
 571 }
 572 }
 573
 574 print "</select></td></tr>\n";
 575
 576 printf "<tr><td>Order bugs by</td><td>%s</td></tr>\n",
 577     pkg_htmlselectyesno("pend-rev", "outstanding bugs first", "done bugs first", $pend_rev);
 578 printf "<tr><td></td><td>%s</td></tr>\n",
 579     pkg_htmlselectyesno("sev-rev", "highest severity first", "lowest severity first", $sev_rev);
 580 printf "<tr><td></td><td>%s</td></tr>\n",
 581     pkg_htmlselectyesno("bug-rev", "oldest bugs first", "newest bugs first", $bug_rev);
 582
 583 print <<EOF;
 584 <tr><td>&nbsp;</td></tr>
 585 <tr><td colspan=2><input value="Reload page" type="submit"> with new settings</td></tr>
 586 EOF
 587
 588 print "</table></form></div>\n";
 589
 590 print "<hr>\n";
 591 print "<p>$tail_html";
 592
 593 print "</body></html>\n";
 594
 595 sub pkg_htmlindexentrystatus {
 596     my $s = shift;
 597     my %status = %{$s};
 598
 599     my $result = "";
 600
 601     my $showseverity;
 602     if  ($status{severity} eq 'normal') {
 603         $showseverity = '';
 604     } elsif (isstrongseverity($status{severity})) {
 605         $showseverity = "Severity: <em class=\"severity\">$status{severity}</em>;\n";
 606     } else {
 607         $showseverity = "Severity: <em>$status{severity}</em>;\n";
 608     }
 609
 610     $result .= pkg_htmlpackagelinks($status{"package"}, 1);
 611
 612     my $showversions = '';
 613     if (@{$status{found_versions}}) {
 614         my @found = @{$status{found_versions}};
 615         $showversions .= join ', ', map {s{/}{ }; htmlsanit($_)} @found;
 616     }
 617     if (@{$status{fixed_versions}}) {
 618         $showversions .= '; ' if length $showversions;
 619         $showversions .= '<strong>fixed</strong>: ';
 620         my @fixed = @{$status{fixed_versions}};
 621         $showversions .= join ', ', map {s{/}{ }; htmlsanit($_)} @fixed;
 622     }
 623     $result .= ' (<a href="'.
 624          version_url($status{package},
 625                      $status{found_versions},
 626                      $status{fixed_versions},
 627                     ).qq{">$showversions</a>)} if length $showversions;
 628     $result .= ";\n";
 629
 630     $result .= $showseverity;
 631     $result .= pkg_htmladdresslinks("Reported by: ", \&submitterurl,
 632                                 $status{originator});
 633     $result .= ";\nOwned by: " . htmlsanit($status{owner})
 634                if length $status{owner};
 635     $result .= ";\nTags: <strong>"
 636                  . htmlsanit(join(", ", sort(split(/\s+/, $status{tags}))))
 637                  . "</strong>"
 638                        if (length($status{tags}));
 639
 640     $result .= buglinklist(";\nMerged with ", ", ",
 641         split(/ /,$status{mergedwith}));
 642     $result .= buglinklist(";\nBlocked by ", ", ",
 643         split(/ /,$status{blockedby}));
 644     $result .= buglinklist(";\nBlocks ", ", ",
 645         split(/ /,$status{blocks}));
 646
 647     if (length($status{done})) {
 648         $result .= "<br><strong>Done:</strong> " . htmlsanit($status{done});
 649         my $days = bug_archiveable(bug => $status{id},
 650                                    status => \%status,
 651                                    days_until => 1,
 652                                   );
 653         if ($days >= 0 and defined $status{location} and $status{location} ne 'archive') {
 654             $result .= ";\n<strong>Will be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
 655         }
 656     }
 657
 658     unless (length($status{done})) {
 659         if (length($status{forwarded})) {
 660             $result .= ";\n<strong>Forwarded</strong> to "
 661                        . join(', ',
 662                               map {maybelink($_)}
 663                               split /[,\s]+/,$status{forwarded}
 664                              );
 665         }
 666         # Check the age of the logfile
 667         my ($days_last,$eng_last) = secs_to_english(time - $status{log_modified});
 668         my ($days,$eng) = secs_to_english(time - $status{date});
 669
 670         if ($days >= 7) {
 671             my $font = "";
 672             my $efont = "";
 673             $font = "em" if ($days > 30);
 674             $font = "strong" if ($days > 60);
 675             $efont = "</$font>" if ($font);
 676             $font = "<$font>" if ($font);
 677
 678             $result .= ";\n ${font}$eng old$efont";
 679         }
 680         if ($days_last > 7) {
 681             my $font = "";
 682             my $efont = "";
 683             $font = "em" if ($days_last > 30);
 684             $font = "strong" if ($days_last > 60);
 685             $efont = "</$font>" if ($font);
 686             $font = "<$font>" if ($font);
 687
 688             $result .= ";\n ${font}Modified $eng_last ago$efont";
 689         }
 690     }
 691
 692     $result .= ".";
 693
 694     return $result;
 695 }
 696
 697
 698 sub pkg_htmlizebugs {
 699     $b = $_[0];
 700     my @bugs = @$b;
 701
 702     my @status = ();
 703     my %count;
 704     my $header = '';
 705     my $footer = "<h2 class=\"outstanding\">Summary</h2>\n";
 706
 707     my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay);  #, $gHTMLExpireNote);
 708
 709     if (@bugs == 0) {
 710         return "<HR><H2>No reports found!</H2></HR>\n";
 711     }
 712
 713     if ( $bug_rev ) {
 714         @bugs = sort {$b<=>$a} @bugs;
 715     } else {
 716         @bugs = sort {$a<=>$b} @bugs;
 717     }
 718     my %seenmerged;
 719
 720     my %common = (
 721         'show_list_header' => 1,
 722         'show_list_footer' => 1,
 723     );
 724
 725     my %section = ();
 726
 727     foreach my $bug (@bugs) {
 728         my %status = %{getbugstatus($bug)};
 729         next unless %status;
 730         next if bugfilter($bug, %status);
 731
 732         my $html = sprintf "<li><a href=\"%s\">#%d: %s</a>\n<br>",
 733             bugurl($bug), $bug, htmlsanit($status{subject});
 734         $html .= pkg_htmlindexentrystatus(\%status) . "\n";
 735         push @status, [ $bug, \%status, $html ];
 736     }
 737     print STDERR "nbnug_order: $bug_order\n";
 738     if ($bug_order eq 'age') {
 739          # MWHAHAHAHA
 740          @status = sort {$a->[1]{log_modified} <=> $b->[1]{log_modified}} @status;
 741     }
 742     elsif ($bug_order eq 'agerev') {
 743          @status = sort {$b->[1]{log_modified} <=> $a->[1]{log_modified}} @status;
 744     }
 745     for my $entry (@status) {
 746         my $key = "";
 747         for my $i (0..$#prior) {
 748             my $v = get_bug_order_index($prior[$i], $entry->[1]);
 749             $count{"g_${i}_${v}"}++;
 750             $key .= "_$v";
 751         }
 752         $section{$key} .= $entry->[2];
 753         $count{"_$key"}++;
 754     }
 755
 756     my $result = "";
 757     if ($ordering eq "raw") {
 758         $result .= "<UL class=\"bugs\">\n" . join("", map( { $_->[ 2 ] } @status ) ) . "</UL>\n";
 759     } else {
 760         $header .= "<ul>\n<div class=\"msgreceived\">\n";
 761         my @keys_in_order = ("");
 762         for my $o (@order) {
 763             push @keys_in_order, "X";
 764             while ((my $k = shift @keys_in_order) ne "X") {
 765                 for my $k2 (@{$o}) {
 766                     $k2+=0;
 767                     push @keys_in_order, "${k}_${k2}";
 768                 }
 769             }
 770         }
 771         for my $order (@keys_in_order) {
 772             next unless defined $section{$order};
 773             my @ttl = split /_/, $order; shift @ttl;
 774             my $title = $title[0]->[$ttl[0]] . " bugs";
 775             if ($#ttl > 0) {
 776                 $title .= " -- ";
 777                 $title .= join("; ", grep {($_ || "") ne ""}
 778                         map { $title[$_]->[$ttl[$_]] } 1..$#ttl);
 779             }
 780             $title = htmlsanit($title);
 781
 782             my $count = $count{"_$order"};
 783             my $bugs = $count == 1 ? "bug" : "bugs";
 784
 785             $header .= "<li><a href=\"#$order\">$title</a> ($count $bugs)</li>\n";
 786             if ($common{show_list_header}) {
 787                 my $count = $count{"_$order"};
 788                 my $bugs = $count == 1 ? "bug" : "bugs";
 789                 $result .= "<H2 CLASS=\"outstanding\"><a name=\"$order\"></a>$title ($count $bugs)</H2>\n";
 790             } else {
 791                 $result .= "<H2 CLASS=\"outstanding\">$title</H2>\n";
 792             }
 793             $result .= "<div class=\"msgreceived\">\n<UL class=\"bugs\">\n";
 794             $result .= "\n\n\n\n";
 795             $result .= $section{$order};
 796             $result .= "\n\n\n\n";
 797             $result .= "</UL>\n</div>\n";
 798         }
 799         $header .= "</ul></div>\n";
 800
 801         $footer .= "<ul>\n<div class=\"msgreceived\">";
 802         for my $i (0..$#prior) {
 803             my $local_result = '';
 804             foreach my $key ( @{$order[$i]} ) {
 805                 my $count = $count{"g_${i}_$key"};
 806                 next if !$count or !$title[$i]->[$key];
 807                 $local_result .= "<li>$count $title[$i]->[$key]</li>\n";
 808             }
 809             if ( $local_result ) {
 810                 $footer .= "<li>$names[$i]<ul>\n$local_result</ul></li>\n";
 811             }
 812         }
 813         $footer .= "</div></ul>\n";
 814     }
 815
 816     $result = $header . $result if ( $common{show_list_header} );
 817     $result .= $footer if ( $common{show_list_footer} );
 818     return $result;
 819 }
 820
 821 sub pkg_htmlpackagelinks {
 822     my $pkgs = shift;
 823     return unless defined $pkgs and $pkgs ne '';
 824     my $strong = shift;
 825     my @pkglist = splitpackages($pkgs);
 826
 827     $strong = 0;
 828     my $openstrong  = $strong ? '<strong>' : '';
 829     my $closestrong = $strong ? '</strong>' : '';
 830
 831     return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' .
 832            join(', ',
 833                 map {
 834                     '<a class="submitter" href="' . pkgurl($_) . '">' .
 835                     $openstrong . htmlsanit($_) . $closestrong . '</a>'
 836                 } @pkglist
 837            );
 838 }
 839
 840 sub pkg_htmladdresslinks {
 841      htmlize_addresslinks(@_,'submitter');
 842 }
 843
 844 sub pkg_javascript {
 845     return <<EOF ;
 846 <script type="text/javascript">
 847 <!--
 848 function pagemain() {
 849         toggle(1);
 850 //      toggle(2);
 851         enable(1);
 852 }
 853
 854 function setCookie(name, value, expires, path, domain, secure) {
 855   var curCookie = name + "=" + escape(value) +
 856       ((expires) ? "; expires=" + expires.toGMTString() : "") +
 857       ((path) ? "; path=" + path : "") +
 858       ((domain) ? "; domain=" + domain : "") +
 859       ((secure) ? "; secure" : "");
 860   document.cookie = curCookie;
 861 }
 862
 863 function save_cat_cookies() {
 864   var cat = document.categories.categorisation.value;
 865   var exp = new Date();
 866   exp.setTime(exp.getTime() + 10 * 365 * 24 * 60 * 60 * 1000);
 867   var oldexp = new Date();
 868   oldexp.setTime(oldexp.getTime() - 1 * 365 * 24 * 60 * 60 * 1000);
 869   var lev;
 870   var done = 0;
 871
 872   var u = document.getElementById("users");
 873   if (u != null) { u = u.value; }
 874   if (u == "") { u = null; }
 875   if (u != null) {
 876       setCookie("cat" + cat + "_users", u, exp, "/");
 877   } else {
 878       setCookie("cat" + cat + "_users", "", oldexp, "/");
 879   }
 880
 881   var bits = new Array("nam", "pri", "ttl", "ord");
 882   for (var i = 0; i < 4; i++) {
 883       for (var j = 0; j < bits.length; j++) {
 884           var e = document.getElementById(bits[j] + i);
 885           if (e) e = e.value;
 886           if (e == null) { e = ""; }
 887           if (j == 0 && e == "") { done = 1; }
 888           if (done || e == "") {
 889               setCookie("cat" + cat + "_" + bits[j] + i, "", oldexp, "/");
 890           } else {
 891               setCookie("cat" + cat + "_" + bits[j] + i, e, exp, "/");
 892           }
 893       }
 894   }
 895 }
 896
 897 function toggle(i) {
 898         var a = document.getElementById("a_" + i);
 899         if (a) {
 900              if (a.style.display == "none") {
 901                      a.style.display = "";
 902              } else {
 903                      a.style.display = "none";
 904              }
 905         }
 906 }
 907
 908 function enable(x) {
 909     for (var i = 1; ; i++) {
 910         var a = document.getElementById("b_" + x + "_" + i);
 911         if (a == null) break;
 912         var ischecked = a.checked;
 913         for (var j = 1; ; j++) {
 914             var b = document.getElementById("b_" + x + "_"+ i + "_" + j);
 915             if (b == null) break;
 916             if (ischecked) {
 917                 b.disabled = false;
 918             } else {
 919                 b.disabled = true;
 920             }
 921         }
 922     }
 923 }
 924 -->
 925 </script>
 926 EOF
 927 }
 928
 929 sub pkg_htmlselectyesno {
 930     my ($name, $n, $y, $default) = @_;
 931     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);
 932 }
 933
 934 sub pkg_htmlselectsuite {
 935     my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
 936     my @suites = ("stable", "testing", "unstable", "experimental");
 937     my %suiteaka = ("stable", "etch", "testing", "lenny", "unstable", "sid");
 938     my $defaultsuite = "unstable";
 939
 940     my $result = sprintf '<select name=dist id="%s">', $id;
 941     for my $s (@suites) {
 942         $result .= sprintf '<option value="%s"%s>%s%s</option>',
 943                 $s, ($defaultsuite eq $s ? " selected" : ""),
 944                 $s, (defined $suiteaka{$s} ? " (" . $suiteaka{$s} . ")" : "");
 945     }
 946     $result .= '</select>';
 947     return $result;
 948 }
 949
 950 sub pkg_htmlselectarch {
 951     my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
 952     my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc);
 953
 954     my $result = sprintf '<select name=arch id="%s">', $id;
 955     $result .= '<option value="any">any architecture</option>';
 956     for my $a (@arches) {
 957         $result .= sprintf '<option value="%s">%s</option>', $a, $a;
 958     }
 959     $result .= '</select>';
 960     return $result;
 961 }
 962
 963 sub myurl {
 964      return urlsanit(pkg_url(map {exists $param{$_}?($_,$param{$_}):()}
 965                              qw(archive repeatmerged mindays maxdays),
 966                              qw(version dist arch pkg src tag maint submitter)
 967                             )
 968                     );
 969 }
 970
 971 sub make_order_list {
 972     my $vfull = shift;
 973     my @x = ();
 974
 975     if ($vfull =~ m/^([^:]+):(.*)$/) {
 976         my $v = $1;
 977         for my $vv (split /,/, $2) {
 978             push @x, "$v=$vv";
 979         }
 980     } else {
 981         for my $v (split /,/, $vfull) {
 982             next unless $v =~ m/.=./;
 983             push @x, $v;
 984         }
 985     }
 986     push @x, "";  # catch all
 987     return @x;
 988 }
 989
 990 sub get_bug_order_index {
 991     my $order = shift;
 992     my $status = shift;
 993     my $pos = -1;
 994
 995     my %tags = ();
 996     %tags = map { $_, 1 } split / /, $status->{"tags"}
 997         if defined $status->{"tags"};
 998
 999     for my $el (@${order}) {
1000         $pos++;
1001         my $match = 1;
1002         for my $item (split /[+]/, $el) {
1003             my ($f, $v) = split /=/, $item, 2;
1004             next unless (defined $f and defined $v);
1005             my $isokay = 0;
1006             $isokay = 1 if (defined $status->{$f} and $v eq $status->{$f});
1007             $isokay = 1 if ($f eq "tag" && defined $tags{$v});
1008             unless ($isokay) {
1009                 $match = 0;
1010                 last;
1011             }
1012         }
1013         if ($match) {
1014             return $pos;
1015             last;
1016         }
1017     }
1018     return $pos + 1;
1019 }
1020
1021 sub buglinklist {
1022     my ($prefix, $infix, @els) = @_;
1023     return '' if not @els;
1024     return $prefix . bug_linklist($infix,'submitter',@els);
1025 }
1026
1027
1028 # sets: my @names; my @prior; my @title; my @order;
1029
1030 sub determine_ordering {
1031     $cats{status}[0]{ord} = [ reverse @{$cats{status}[0]{ord}} ]
1032         if ($pend_rev);
1033     $cats{severity}[0]{ord} = [ reverse @{$cats{severity}[0]{ord}} ]
1034         if ($sev_rev);
1035
1036     my $i;
1037     if (defined $param{"pri0"}) {
1038         my @c = ();
1039         $i = 0;
1040         while (defined $param{"pri$i"}) {
1041             my $h = {};
1042
1043             my $pri = $param{"pri$i"};
1044             if ($pri =~ m/^([^:]*):(.*)$/) {
1045               $h->{"nam"} = $1;  # overridden later if necesary
1046               $h->{"pri"} = [ map { "$1=$_" } (split /,/, $2) ];
1047             } else {
1048               $h->{"pri"} = [ split /,/, $pri ];
1049             }
1050
1051             $h->{"nam"} = $param{"nam$i"}
1052                 if (defined $param{"nam$i"});
1053             $h->{"ord"} = [ split /\s*,\s*/, $param{"ord$i"} ]
1054                 if (defined $param{"ord$i"});
1055             $h->{"ttl"} = [ split /\s*,\s*/, $param{"ttl$i"} ]
1056                 if (defined $param{"ttl$i"});
1057
1058             push @c, $h;
1059             $i++;
1060         }
1061         $cats{"_"} = [@c];
1062         $ordering = "_";
1063     }
1064
1065     $ordering = "normal" unless defined $cats{$ordering};
1066
1067     sub get_ordering {
1068         my @res;
1069         my $cats = shift;
1070         my $o = shift;
1071         for my $c (@{$cats->{$o}}) {
1072             if (ref($c) eq "HASH") {
1073                 push @res, $c;
1074             } else {
1075                 push @res, get_ordering($cats, $c);
1076             }
1077         }
1078         return @res;
1079     }
1080     my @cats = get_ordering(\%cats, $ordering);
1081
1082     sub toenglish {
1083         my $expr = shift;
1084         $expr =~ s/[+]/ and /g;
1085         $expr =~ s/[a-z]+=//g;
1086         return $expr;
1087     }
1088
1089     $i = 0;
1090     for my $c (@cats) {
1091         $i++;
1092         push @prior, $c->{"pri"};
1093         push @names, ($c->{"nam"} || "Bug attribute #" . $i);
1094         if (defined $c->{"ord"}) {
1095             push @order, $c->{"ord"};
1096         } else {
1097             push @order, [ 0..$#{$prior[-1]} ];
1098         }
1099         my @t = @{ $c->{"ttl"} } if defined $c->{ttl};
1100         if (@t < $#{$prior[-1]}) {
1101              push @t, map { toenglish($prior[-1][$_]) } @t..($#{$prior[-1]});
1102         }
1103         push @t, $c->{"def"} || "";
1104         push @title, [@t];
1105     }
1106 }