cgi/pkgreport.cgi

   1 #!/usr/bin/perl -wT
   2
   3 package debbugs;
   4
   5 use strict;
   6 use POSIX qw(strftime tzset nice);
   7
   8 #require '/usr/lib/debbugs/errorlib';
   9 require './common.pl';
  10
  11 require '/etc/debbugs/config';
  12 require '/etc/debbugs/text';
  13
  14 use vars qw($gPackagePages $gWebDomain);
  15
  16 if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') {
  17     print "Content-Type: text/html; charset=utf-8\n\n";
  18     exit 0;
  19 }
  20
  21 nice(5);
  22
  23 my $userAgent = detect_user_agent();
  24 my %param = readparse();
  25
  26 my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes";
  27 my $archive = ($param{'archive'} || "no") eq "yes";
  28 my $include = $param{'&include'} || $param{'include'} || "";
  29 my $exclude = $param{'&exclude'} || $param{'exclude'} || "";
  30 my $raw_sort = ($param{'raw'} || "no") eq "yes";
  31 my $bug_rev = ($param{'bug-rev'} || "no") eq "yes";
  32 my $pend_rev = ($param{'pend-rev'} || "no") eq "yes";
  33 my $sev_rev = ($param{'sev-rev'} || "no") eq "yes";
  34 my $pend_exc = $param{'&pend-exc'} || $param{'pend-exc'} || "";
  35 my $pend_inc = $param{'&pend-inc'} || $param{'pend-inc'} || "";
  36 my $sev_exc = $param{'&sev-exc'} || $param{'sev-exc'} || "";
  37 my $sev_inc = $param{'&sev-inc'} || $param{'sev-inc'} || "";
  38 my $maxdays = ($param{'maxdays'} || -1);
  39 my $mindays = ($param{'mindays'} || 0);
  40 my $version = $param{'version'} || undef;
  41 my $dist = $param{'dist'} || undef;
  42 my $arch = $param{'arch'} || undef;
  43 my $show_list_header = ($param{'show_list_header'} || $userAgent->{'show_list_header'} || "yes" ) eq "yes";
  44 my $show_list_footer = ($param{'show_list_footer'} || $userAgent->{'show_list_footer'} || "yes" ) eq "yes";
  45
  46 {
  47     if (defined $param{'vt'}) {
  48         my $vt = $param{'vt'};
  49         if ($vt eq "none") { $dist = undef; $arch = undef; $version = undef; }
  50         if ($vt eq "bysuite") {
  51             $version = undef;
  52             $arch = undef if ($arch eq "any");
  53         }
  54         if ($vt eq "bypkg" || $vt eq "bysrc") { $dist = undef; $arch = undef; }
  55     }
  56     if (defined $param{'ordering'}) {
  57         my $o = $param{'ordering'};
  58         if ($o eq "raw") { $raw_sort = 1; $bug_rev = 0; }
  59         if ($o eq "normal") { $raw_sort = 0; $bug_rev = 0; }
  60         if ($o eq "reverse") { $raw_sort = 0; $bug_rev = 1; }
  61     }
  62     if (defined $param{'includesubj'}) {
  63         my $is = $param{'includesubj'};
  64         $include .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $is));
  65     }
  66     if (defined $param{'excludesubj'}) {
  67         my $es = $param{'excludesubj'};
  68         $exclude .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $es));
  69     }
  70 }
  71
  72
  73 my ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status, $tag);
  74
  75 my %which = (
  76         'pkg' => \$pkg,
  77         'src' => \$src,
  78         'maint' => \$maint,
  79         'maintenc' => \$maintenc,
  80         'submitter' => \$submitter,
  81         'severity' => \$severity,
  82         'tag' => \$tag,
  83         );
  84 my @allowedEmpty = ( 'maint' );
  85
  86 my $found;
  87 foreach ( keys %which ) {
  88         $status = $param{'status'} || 'open' if /^severity$/;
  89         if (($found = $param{$_})) {
  90                 ${ $which{$_} } = $found;
  91                 last;
  92         }
  93 }
  94 if (!$found && !$archive) {
  95         foreach ( @allowedEmpty ) {
  96                 if (exists($param{$_})) {
  97                         ${ $which{$_} } = '';
  98                         $found = 1;
  99                         last;
 100                 }
 101         }
 102 }
 103 if (!$found) {
 104         my $which;
 105         if (($which = $param{'which'})) {
 106                 if (grep( /^\Q$which\E$/, @allowedEmpty)) {
 107                         ${ $which{$which} } = $param{'data'};
 108                         $found = 1;
 109                 } elsif (($found = $param{'data'})) {
 110                         ${ $which{$which} } = $found if (exists($which{$which}));
 111                 }
 112         }
 113 }
 114 quitcgi("You have to choose something to select by") if (!$found);
 115
 116 my $Archived = $archive ? " Archived" : "";
 117
 118 my $this = "";
 119
 120 my %indexentry;
 121 my %strings = ();
 122
 123 $ENV{"TZ"} = 'UTC';
 124 tzset();
 125
 126 my $dtime = strftime "%a, %e %b %Y %T UTC", localtime;
 127 my $tail_html = $debbugs::gHTMLTail;
 128 $tail_html = $debbugs::gHTMLTail;
 129 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
 130
 131 set_option("repeatmerged", $repeatmerged);
 132 set_option("archive", $archive);
 133 set_option("include", $include);
 134 set_option("exclude", $exclude);
 135 set_option("raw", $raw_sort);
 136 set_option("bug-rev", $bug_rev);
 137 set_option("pend-rev", $pend_rev);
 138 set_option("sev-rev", $sev_rev);
 139 set_option("pend-exc", $pend_exc);
 140 set_option("pend-inc", $pend_inc);
 141 set_option("sev-exc", $sev_exc);
 142 set_option("sev-inc", $sev_inc);
 143 set_option("maxdays", $maxdays);
 144 set_option("mindays", $mindays);
 145 set_option("version", $version);
 146 set_option("dist", $dist);
 147 set_option("arch", $arch);
 148 set_option("use-bug-idx", defined($param{'use-bug-idx'}) ? $param{'use-bug-idx'} : 0);
 149 set_option("show_list_header", $show_list_header);
 150 set_option("show_list_footer", $show_list_footer);
 151
 152 my $title;
 153 my @bugs;
 154 if (defined $pkg) {
 155   $title = "package $pkg";
 156   if (defined $version) {
 157     $title .= " (version $version)";
 158   } elsif (defined $dist) {
 159     $title .= " in $dist";
 160     my $verdesc = getversiondesc($pkg);
 161     $title .= " ($verdesc)" if defined $verdesc;
 162   }
 163   my @pkgs = split /,/, $pkg;
 164   @bugs = @{getbugs(sub {my %d=@_;
 165                          foreach my $try (splitpackages($d{"pkg"})) {
 166                            return 1 if grep($try eq $_, @pkgs);
 167                          }
 168                          return 0;
 169                         }, 'package', @pkgs)};
 170 } elsif (defined $src) {
 171   $title = "source $src";
 172   set_option('arch', 'source');
 173   if (defined $version) {
 174     $title .= " (version $version)";
 175   } elsif (defined $dist) {
 176     $title .= " in $dist";
 177     my $verdesc = getversiondesc($src);
 178     $title .= " ($verdesc)" if defined $verdesc;
 179   }
 180   my @pkgs = ();
 181   my @srcs = split /,/, $src;
 182   foreach my $try (@srcs) {
 183     push @pkgs, getsrcpkgs($try);
 184     push @pkgs, $try if ( !grep(/^\Q$try\E$/, @pkgs) );
 185   }
 186   @bugs = @{getbugs(sub {my %d=@_;
 187                          foreach my $try (splitpackages($d{"pkg"})) {
 188                            return 1 if grep($try eq $_, @pkgs);
 189                          }
 190                          return 0;
 191                         }, 'package', @pkgs)};
 192 } elsif (defined $maint) {
 193   my %maintainers = %{getmaintainers()};
 194   $title = "maintainer $maint";
 195   $title .= " in $dist" if defined $dist;
 196   if ($maint eq "") {
 197     @bugs = @{getbugs(sub {my %d=@_;
 198                            foreach my $try (splitpackages($d{"pkg"})) {
 199                              return 1 if !getparsedaddrs($maintainers{$try});
 200                            }
 201                            return 0;
 202                           })};
 203   } else {
 204     my @maints = split /,/, $maint;
 205     my @pkgs = ();
 206     foreach my $try (@maints) {
 207       foreach my $p (keys %maintainers) {
 208         my @me = getparsedaddrs($maintainers{$p});
 209         push @pkgs, $p if grep { $_->address eq $try } @me;
 210       }
 211     }
 212     @bugs = @{getbugs(sub {my %d=@_;
 213                            foreach my $try (splitpackages($d{"pkg"})) {
 214                              my @me = getparsedaddrs($maintainers{$try});
 215                              return 1 if grep { $_->address eq $maint } @me;
 216                            }
 217                            return 0;
 218                           }, 'package', @pkgs)};
 219   }
 220 } elsif (defined $maintenc) {
 221   my %maintainers = %{getmaintainers()};
 222   $title = "encoded maintainer $maintenc";
 223   $title .= " in $dist" if defined $dist;
 224   @bugs = @{getbugs(sub {my %d=@_;
 225                          foreach my $try (splitpackages($d{"pkg"})) {
 226                            my @me = getparsedaddrs($maintainers{$try});
 227                            return 1 if grep {
 228                              maintencoded($_->address) eq $maintenc
 229                            } @me;
 230                          }
 231                          return 0;
 232                         })};
 233 } elsif (defined $submitter) {
 234   $title = "submitter $submitter";
 235   $title .= " in $dist" if defined $dist;
 236   my @submitters = split /,/, $submitter;
 237   @bugs = @{getbugs(sub {my %d=@_;
 238                          my @se = getparsedaddrs($d{"submitter"} || "");
 239                          foreach my $try (@submitters) {
 240                            return 1 if grep { $_->address eq $try } @se;
 241                          }
 242                         }, 'submitter-email', @submitters)};
 243 } elsif (defined($severity) && defined($status)) {
 244   $title = "$status $severity bugs";
 245   $title .= " in $dist" if defined $dist;
 246   my @severities = split /,/, $severity;
 247   my @statuses = split /,/, $status;
 248   @bugs = @{getbugs(sub {my %d=@_;
 249                        return (grep($d{"severity"} eq $_, @severities))
 250                          && (grep($d{"status"} eq $_, @statuses));
 251                      })};
 252 } elsif (defined($severity)) {
 253   $title = "$severity bugs";
 254   $title .= " in $dist" if defined $dist;
 255   my @severities = split /,/, $severity;
 256   @bugs = @{getbugs(sub {my %d=@_;
 257                        return (grep($d{"severity"} eq $_, @severities));
 258                      }, 'severity', @severities)};
 259 } elsif (defined($tag)) {
 260   $title = "bugs tagged $tag";
 261   $title .= " in $dist" if defined $dist;
 262   my @tags = split /,/, $tag;
 263   @bugs = @{getbugs(sub {my %d = @_;
 264                          my %tags = map { $_ => 1 } split ' ', $d{"tags"};
 265                          return grep(exists $tags{$_}, @tags);
 266                         })};
 267 }
 268
 269 my $result = pkg_htmlizebugs(\@bugs);
 270
 271 print "Content-Type: text/html; charset=utf-8\n\n";
 272
 273 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
 274 print "<HTML><HEAD>\n" .
 275     "<TITLE>$debbugs::gProject$Archived $debbugs::gBug report logs: $title</TITLE>\n" .
 276     '<link rel="stylesheet" href="/css/bugs.css" type="text/css">' .
 277     "</HEAD>\n" .
 278     '<BODY onload="toggle(1);enable(1);">' .
 279     "\n";
 280 print "<H1>" . "$debbugs::gProject$Archived $debbugs::gBug report logs: $title" .
 281       "</H1>\n";
 282
 283 my $showresult = 1;
 284
 285 if (defined $pkg || defined $src) {
 286     my $showpkg = (defined $pkg) ? $pkg : "source package $src";
 287     my %maintainers = %{getmaintainers()};
 288     my $maint = $pkg ? $maintainers{$pkg} : $maintainers{$src} ? $maintainers{$src} : undef;
 289     if (defined $maint) {
 290         print '<p>';
 291         print htmlmaintlinks(sub { $_[0] == 1 ? "Maintainer for $showpkg is "
 292                                               : "Maintainers for $showpkg are "
 293                                  },
 294                              $maint);
 295         print ".</p>\n";
 296     } else {
 297         print "<p>No maintainer for $showpkg. Please do not report new bugs against this package.</p>\n";
 298     }
 299     if (defined $maint or @bugs) {
 300         my %pkgsrc = %{getpkgsrc()};
 301         my $srcforpkg;
 302         if (defined $pkg) {
 303             $srcforpkg = $pkgsrc{$pkg};
 304             defined $srcforpkg or $srcforpkg = $pkg;
 305         }
 306         my @pkgs = getsrcpkgs($pkg ? $srcforpkg : $src);
 307         undef $srcforpkg unless @pkgs;
 308         @pkgs = grep( !/^\Q$pkg\E$/, @pkgs ) if ( $pkg );
 309         if ( @pkgs ) {
 310             @pkgs = sort @pkgs;
 311             if ($pkg) {
 312                     print "<p>You may want to refer to the following packages that are part of the same source:\n";
 313             } else {
 314                     print "<p>You may want to refer to the following individual bug pages:\n";
 315             }
 316             push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) );
 317             print join( ", ", map( "<A href=\"" . pkgurl($_) . "\">$_</A>", @pkgs ) );
 318             print ".\n";
 319         }
 320         my @references;
 321         my $pseudodesc = getpseudodesc();
 322         if ($pkg and defined($pseudodesc) and exists($pseudodesc->{$pkg})) {
 323             push @references, "to the <a href=\"http://${debbugs::gWebDomain}/pseudo-packages${debbugs::gHTMLSuffix}\">list of other pseudo-packages</a>";
 324         } else {
 325             if ($pkg and defined $debbugs::gPackagePages) {
 326                 push @references, sprintf "to the <a href=\"%s\">%s package page</a>", urlsanit("http://${debbugs::gPackagePages}/$pkg"), htmlsanit("$pkg");
 327             }
 328             if (defined $debbugs::gSubscriptionDomain) {
 329                 my $ptslink = $pkg ? $srcforpkg : $src;
 330                 push @references, "to the <a href=\"http://$debbugs::gSubscriptionDomain/$ptslink\">Package Tracking System</a>";
 331             }
 332             # Only output this if the source listing is non-trivial.
 333             if ($pkg and $srcforpkg and (@pkgs or $pkg ne $srcforpkg)) {
 334                 push @references, sprintf "to the source package <a href=\"%s\">%s</a>'s bug page", srcurl($srcforpkg), htmlsanit($srcforpkg);
 335             }
 336         }
 337         if ($pkg) {
 338             set_option("archive", !$archive);
 339             push @references, sprintf "to the <a href=\"%s\">%s reports for %s</a>", pkgurl($pkg), ($archive ? "active" : "archived"), htmlsanit($pkg);
 340             set_option("archive", $archive);
 341         }
 342         if (@references) {
 343             $references[$#references] = "or $references[$#references]" if @references > 1;
 344             print "<p>You might like to refer ", join(", ", @references), ".</p>\n";
 345         }
 346         print "<p>If you find a bug not listed here, please\n";
 347         printf "<a href=\"%s\">report it</a>.</p>\n",
 348                urlsanit("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}");
 349     } else {
 350         print "<p>There is no record of the " .
 351               (defined($pkg) ? htmlsanit($pkg) . " package"
 352                              : htmlsanit($src) . " source package") .
 353               ", and no bugs have been filed against it.</p>";
 354         $showresult = 0;
 355     }
 356 } elsif (defined $maint || defined $maintenc) {
 357     print "<p>Note that maintainers may use different Maintainer fields for\n";
 358     print "different packages, so there may be other reports filed under\n";
 359     print "different addresses.\n";
 360 } elsif (defined $submitter) {
 361     print "<p>Note that people may use different email accounts for\n";
 362     print "different bugs, so there may be other reports filed under\n";
 363     print "different addresses.\n";
 364 }
 365
 366 print $result if $showresult;
 367
 368 print pkg_javascript();
 369 print "<h2 class=\"outstanding\"><a class=\"options\" href=\"javascript:toggle(1)\">Options</a></h2>\n";
 370 print "<div id=\"a_1\">\n";
 371 printf "<form action=\"%s\" method=POST>\n", myurl();
 372
 373 print "<table class=\"forms\">\n";
 374
 375 my ($checked_any, $checked_sui, $checked_ver) = ("", "", "");
 376 if (defined $dist) {
 377   $checked_sui = "CHECKED";
 378 } elsif (defined $version) {
 379   $checked_ver = "CHECKED";
 380 } else {
 381   $checked_any = "CHECKED";
 382 }
 383
 384 print "<tr><td>Show bugs applicable to</td>\n";
 385 print "    <td><input id=\"b_1_1\" name=vt value=none type=radio onchange=\"enable(1);\" $checked_any>anything</td></tr>\n";
 386 print "<tr><td></td>";
 387 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";
 388
 389 if (defined $pkg) {
 390     my $v = $version || "";
 391     print "<tr><td></td>";
 392     print "    <td><input id=\"b_1_3\" name=vt value=bypkg type=radio onchange=\"enable(1);\" $checked_ver>$pkg version <input id=\"b_1_3_1\" name=version value=\"$v\"></td></tr>\n";
 393 } elsif (defined $src) {
 394     my $v = $version || "";
 395     print "<tr><td></td>";
 396     print "    <td><input name=vt value=bysrc type=radio onchange=\"enable(1);\" $checked_ver>$src version <input id=\"b_1_3_1\" name=version value=\"$v\"></td></tr>\n";
 397 }
 398
 399 my $sel_rmy = ($repeatmerged ? " selected" : "");
 400 my $sel_rmn = ($repeatmerged ? "" : " selected");
 401 my $sel_ordraw = ($raw_sort ? " selected" : "");
 402 my $sel_ordnor = (!$raw_sort && !$bug_rev ? " selected" : "");
 403 my $sel_ordrev = (!$raw_sort && $bug_rev ? " selected" : "");
 404 my $includetags = join(" ", grep { !m/^subj:/i } split /[\s,]+/, $include);
 405 my $excludetags = join(" ", grep { !m/^subj:/i } split /[\s,]+/, $exclude);
 406 my $includesubj = join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } split /[\s,]+/, $include);
 407 my $excludesubj = join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } split /[\s,]+/, $exclude);
 408 my $vismindays = ($mindays == 0 ? "" : $mindays);
 409 my $vismaxdays = ($maxdays == -1 ? "" : $maxdays);
 410
 411 print <<EOF;
 412 <tr><td>Display merged bugs</td><td>
 413 <select name=repeatmerged>
 414 <option value=yes$sel_rmy>separately</option>
 415 <option value=no$sel_rmn>combined</option>
 416 </select>
 417 </td></tr>
 418 <tr><td>Order bugs by</td><td>
 419 <select name=ordering>
 420 <option value=raw$sel_ordraw>bug number</option>
 421 <option value=normal$sel_ordnor>section, oldest first</option>
 422 <option value=reverse$sel_ordrev>section, newest first</option>
 423 </select>
 424 </td></tr>
 425 <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>
 426 <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>
 427 <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>
 428 <tr><td colspan=2><input value="Reload page" type="submit"> with new settings</td></tr>
 429 EOF
 430
 431 print "</table></form></div>\n";
 432
 433 print "<hr>\n";
 434 print "<p>$tail_html";
 435
 436 print "</body></html>\n";
 437
 438 sub pkg_htmlindexentrystatus {
 439     my $s = shift;
 440     my %status = %{$s};
 441
 442     my $result = "";
 443
 444     my $showseverity;
 445     if  ($status{severity} eq 'normal') {
 446         $showseverity = '';
 447     } elsif (isstrongseverity($status{severity})) {
 448         $showseverity = "Severity: <em class=\"severity\">$status{severity}</em>;\n";
 449     } else {
 450         $showseverity = "Severity: <em>$status{severity}</em>;\n";
 451     }
 452
 453     $result .= pkg_htmlpackagelinks($status{"package"}, 1);
 454
 455     my $showversions = '';
 456     if (@{$status{found_versions}}) {
 457         my @found = @{$status{found_versions}};
 458         local $_;
 459         s{/}{ } foreach @found;
 460         $showversions .= join ', ', map htmlsanit($_), @found;
 461     }
 462     if (@{$status{fixed_versions}}) {
 463         $showversions .= '; ' if length $showversions;
 464         $showversions .= '<strong>fixed</strong>: ';
 465         my @fixed = @{$status{fixed_versions}};
 466         local $_;
 467         s{/}{ } foreach @fixed;
 468         $showversions .= join ', ', map htmlsanit($_), @fixed;
 469     }
 470     $result .= " ($showversions)" if length $showversions;
 471     $result .= ";\n";
 472
 473     $result .= $showseverity;
 474     $result .= pkg_htmladdresslinks("Reported by: ", \&submitterurl,
 475                                 $status{originator});
 476     $result .= ";\nOwned by: " . htmlsanit($status{owner})
 477                if length $status{owner};
 478     $result .= ";\nTags: <strong>"
 479                  . htmlsanit(join(", ", sort(split(/\s+/, $status{tags}))))
 480                  . "</strong>"
 481                        if (length($status{tags}));
 482
 483     my @merged= split(/ /,$status{mergedwith});
 484     my $mseparator= ";\nMerged with ";
 485     for my $m (@merged) {
 486         $result .= $mseparator."<A class=\"submitter\" href=\"" . bugurl($m) . "\">#$m</A>";
 487         $mseparator= ", ";
 488     }
 489
 490     my $days = 0;
 491     if (length($status{done})) {
 492         $result .= "<br><strong>Done:</strong> " . htmlsanit($status{done});
 493         $days = ceil($debbugs::gRemoveAge - -M buglog($status{id}));
 494         if ($days >= 0) {
 495             $result .= ";\n<strong>Will be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
 496         } else {
 497             $result .= ";\n<strong>Archived</strong>";
 498         }
 499     }
 500
 501     unless (length($status{done})) {
 502         if (length($status{forwarded})) {
 503             $result .= ";\n<strong>Forwarded</strong> to "
 504                        . maybelink($status{forwarded});
 505         }
 506         my $daysold = int((time - $status{date}) / 86400);   # seconds to days
 507         if ($daysold >= 7) {
 508             my $font = "";
 509             my $efont = "";
 510             $font = "em" if ($daysold > 30);
 511             $font = "strong" if ($daysold > 60);
 512             $efont = "</$font>" if ($font);
 513             $font = "<$font>" if ($font);
 514
 515             my $yearsold = int($daysold / 365);
 516             $daysold -= $yearsold * 365;
 517
 518             $result .= ";\n $font";
 519             my @age;
 520             push @age, "1 year" if ($yearsold == 1);
 521             push @age, "$yearsold years" if ($yearsold > 1);
 522             push @age, "1 day" if ($daysold == 1);
 523             push @age, "$daysold days" if ($daysold > 1);
 524             $result .= join(" and ", @age);
 525             $result .= " old$efont";
 526         }
 527     }
 528
 529     $result .= ".";
 530
 531     return $result;
 532 }
 533
 534
 535 sub pkg_htmlizebugs {
 536     $b = $_[0];
 537     my @bugs = @$b;
 538     my $anydone = 0;
 539
 540     my @status = ();
 541     my %count;
 542     my $header = '';
 543     my $footer = "<h2 class=\"outstanding\">Summary</h2>\n";
 544
 545     my @dummy = ($debbugs::gRemoveAge, @debbugs::gSeverityList, @debbugs::gSeverityDisplay);  #, $debbugs::gHTMLExpireNote);
 546
 547     if (@bugs == 0) {
 548         return "<HR><H2>No reports found!</H2></HR>\n";
 549     }
 550
 551     if ( $bug_rev ) {
 552         @bugs = sort {$b<=>$a} @bugs;
 553     } else {
 554         @bugs = sort {$a<=>$b} @bugs;
 555     }
 556     my %seenmerged;
 557
 558     my @common_grouping = ( 'severity', 'pending' );
 559     my %common_grouping_order = (
 560         'pending' => [ qw( pending forwarded pending-fixed fixed done absent ) ],
 561         'severity' => \@debbugs::gSeverityList,
 562     );
 563     my %common_grouping_display = (
 564         'pending' => 'Status',
 565         'severity' => 'Severity',
 566     );
 567     my %common_headers = (
 568         'pending' => {
 569             "pending"       => "outstanding",
 570             "pending-fixed" => "pending upload",
 571             "fixed"         => "fixed in NMU",
 572             "done"          => "resolved",
 573             "forwarded"     => "forwarded to upstream software authors",
 574             "absent"        => "not applicable to this version",
 575         },
 576         'severity' => \%debbugs::gSeverityDisplay,
 577     );
 578     my %common_reverse = ( 'pending' => $pend_rev, 'severity' => $sev_rev );
 579     my %common = (
 580         'show_list_header' => 1,
 581         'show_list_footer' => 1,
 582     );
 583     my $common_raw_sort = $raw_sort;
 584
 585     my %section = ();
 586
 587     foreach my $bug (@bugs) {
 588         my %status = %{getbugstatus($bug)};
 589         next unless %status;
 590         next if bugfilter($bug, %status);
 591
 592         my $html = sprintf "<li><a href=\"%s\">#%d: %s</a>\n<br>",
 593             bugurl($bug), $bug, htmlsanit($status{subject});
 594         $html .= pkg_htmlindexentrystatus(\%status) . "\n";
 595         my $key = join( '_', map( {$status{$_}} @common_grouping ) );
 596         $section{$key} .= $html;
 597         $count{"_$key"}++;
 598         foreach my $grouping ( @common_grouping ) {
 599             $count{"${grouping}_$status{$grouping}"}++;
 600         }
 601         $anydone = 1 if $status{pending} eq 'done';
 602         push @status, [ $bug, \%status, $html ];
 603     }
 604
 605     my $result = "";
 606     if ($common_raw_sort) {
 607         $result .= "<UL class=\"bugs\">\n" . join("", map( { $_->[ 2 ] } @status ) ) . "</UL>\n";
 608     } else {
 609         my (@order, @headers);
 610         for( my $i = 0; $i < @common_grouping; $i++ ) {
 611             my $grouping_name = $common_grouping[ $i ];
 612             my @items = @{ $common_grouping_order{ $grouping_name } };
 613             @items = reverse( @items ) if ( $common_reverse{ $grouping_name } );
 614             my @neworder = ();
 615             my @newheaders = ();
 616             if ( @order ) {
 617                 foreach my $grouping ( @items ) {
 618                     push @neworder, map( { "${_}_$grouping" } @order );
 619                     push @newheaders, map( { "$_ - $common_headers{$grouping_name}{$grouping}" } @headers );
 620                 }
 621                 @order = @neworder;
 622                 @headers = @newheaders;
 623             } else {
 624                 push @order, @items;
 625                 push @headers, map( { $common_headers{$common_grouping[$i]}{$_} } @items );
 626             }
 627         }
 628         $header .= "<ul>\n<div class=\"msgreceived\">";
 629         for ( my $i = 0; $i < @order; $i++ ) {
 630             my $order = $order[ $i ];
 631             next unless defined $section{$order};
 632             my $count = $count{"_$order"};
 633             my $bugs = $count == 1 ? "bug" : "bugs";
 634             $header .= "<li><a href=\"#$order\">$headers[$i]</a> ($count $bugs)</li>\n";
 635         }
 636         $header .= "</ul></div>\n";
 637         for ( my $i = 0; $i < @order; $i++ ) {
 638             my $order = $order[ $i ];
 639             next unless defined $section{$order};
 640             if ($common{show_list_header}) {
 641                 my $count = $count{"_$order"};
 642                 my $bugs = $count == 1 ? "bug" : "bugs";
 643                 $result .= "<H2 CLASS=\"outstanding\"><a name=\"$order\"></a>$headers[$i] ($count $bugs)</H2>\n";
 644             } else {
 645                 $result .= "<H2 CLASS=\"outstanding\">$headers[$i]</H2>\n";
 646             }
 647             $result .= "<div class=\"msgreceived\">\n<UL class=\"bugs\">\n";
 648             $result .= $section{$order};
 649             $result .= "</UL>\n</div>\n";
 650         }
 651         $footer .= "<ul>\n<div class=\"msgreceived\">";
 652         foreach my $grouping ( @common_grouping ) {
 653             my $local_result = '';
 654             foreach my $key ( @{$common_grouping_order{ $grouping }} ) {
 655                 my $count = $count{"${grouping}_$key"};
 656                 next if !$count;
 657                 $local_result .= "<li>$count $common_headers{$grouping}{$key}</li>\n";
 658             }
 659             if ( $local_result ) {
 660                 $footer .= "<li>$common_grouping_display{$grouping}<ul>\n$local_result</ul></li>\n";
 661             }
 662         }
 663         $footer .= "</div></ul>\n";
 664     }
 665
 666     $result = $header . $result if ( $common{show_list_header} );
 667     #$result .= "<hr><p>" . $debbugs::gHTMLExpireNote if $debbugs::gRemoveAge and $anydone;
 668     $result .= $footer if ( $common{show_list_footer} );
 669     return $result;
 670 }
 671
 672 sub pkg_htmlpackagelinks {
 673     my $pkgs = shift;
 674     return unless defined $pkgs and $pkgs ne '';
 675     my $strong = shift;
 676     my @pkglist = splitpackages($pkgs);
 677
 678     $strong = 0;
 679     my $openstrong  = $strong ? '<strong>' : '';
 680     my $closestrong = $strong ? '</strong>' : '';
 681
 682     return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' .
 683            join(', ',
 684                 map {
 685                     '<a class="submitter" href="' . pkgurl($_) . '">' .
 686                     $openstrong . htmlsanit($_) . $closestrong . '</a>'
 687                 } @pkglist
 688            );
 689 }
 690
 691 sub pkg_htmladdresslinks {
 692     my ($prefixfunc, $urlfunc, $addresses) = @_;
 693     if (defined $addresses and $addresses ne '') {
 694         my @addrs = getparsedaddrs($addresses);
 695         my $prefix = (ref $prefixfunc) ? $prefixfunc->(scalar @addrs)
 696                                        : $prefixfunc;
 697         return $prefix .
 698                join ', ', map { sprintf '<a class="submitter" href="%s">%s</a>',
 699                                         $urlfunc->($_->address),
 700                                         htmlsanit($_->format) || '(unknown)'
 701                               } @addrs;
 702     } else {
 703         my $prefix = (ref $prefixfunc) ? $prefixfunc->(1) : $prefixfunc;
 704         return sprintf '%s<a class="submitter" href="%s">(unknown)</a>', $prefix, $urlfunc->('');
 705     }
 706 }
 707
 708 sub pkg_javascript {
 709     return <<EOF ;
 710 <script type="text/javascript">
 711 <!--
 712
 713 function toggle(i) {
 714         var a = document.getElementById("a_" + i);
 715         if (a.style.display == "none") {
 716                 a.style.display = "";
 717         } else {
 718                 a.style.display = "none";
 719         }
 720 }
 721
 722 function enable(x) {
 723     for (var i = 1; ; i++) {
 724         var a = document.getElementById("b_" + x + "_" + i);
 725         if (a == null) break;
 726         var ischecked = a.checked;
 727         for (var j = 1; ; j++) {
 728             var b = document.getElementById("b_" + x + "_"+ i + "_" + j);
 729             if (b == null) break;
 730             if (ischecked) {
 731                 b.disabled = false;
 732             } else {
 733                 b.disabled = true;
 734             }
 735         }
 736     }
 737 }
 738 -->
 739 </script>
 740 EOF
 741 }
 742
 743 sub pkg_htmlselectsuite {
 744     my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
 745     my @suites = ("stable", "testing", "unstable", "experimental");
 746     my %suiteaka = ("stable", "sarge", "testing", "etch", "unstable", "sid");
 747     my $defaultsuite = "unstable";
 748
 749     my $result = sprintf '<select name=dist id="%s">', $id;
 750     for my $s (@suites) {
 751         $result .= sprintf '<option value="%s"%s>%s%s</option>',
 752                 $s, ($defaultsuite eq $s ? " selected" : ""),
 753                 $s, (defined $suiteaka{$s} ? " (" . $suiteaka{$s} . ")" : "");
 754     }
 755     $result .= '</select>';
 756     return $result;
 757 }
 758
 759 sub pkg_htmlselectarch {
 760     my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
 761     my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc);
 762
 763     my $result = sprintf '<select name=arch id="%s">', $id;
 764     $result .= '<option value="any">any architecture</option>';
 765     for my $a (@arches) {
 766         $result .= sprintf '<option value="%s">%s</option>', $a, $a;
 767     }
 768     $result .= '</select>';
 769     return $result;
 770 }
 771
 772 sub myurl {
 773     return pkg_etc_url($pkg, "pkg", 0) if defined($pkg);
 774     return pkg_etc_url($src, "src", 0) if defined($src);
 775     return pkg_etc_url($maint, "maint", 0) if defined($maint);
 776     return pkg_etc_url($submitter, "submitter", 0) if defined($submitter);
 777     return pkg_etc_url($severity, "severity", 0) if defined($severity);
 778     return pkg_etc_url($tag, "tag", 0) if defined($tag);
 779 }