]> git.donarmstrong.com Git - debbugs.git/blobdiff - cgi/pkgreport.cgi
* Don't show time to archive for archived bugs
[debbugs.git] / cgi / pkgreport.cgi
index 86ba75155a899c4c265d33cd67a0e647b447ac38..cca0aaf6c591d8bd1c2fef703598ff3347f7a1b7 100755 (executable)
@@ -3,18 +3,17 @@
 package debbugs;
 
 use strict;
-use POSIX qw(strftime tzset nice);
+use POSIX qw(strftime nice);
 
-#require '/usr/lib/debbugs/errorlib';
 require './common.pl';
 
-require '/etc/debbugs/config';
-require '/etc/debbugs/text';
-
+use Debbugs::Config qw(:globals :text);
 use Debbugs::User;
-my $cats = 5;
+use Debbugs::CGI qw(version_url);
+use Debbugs::Common qw(getparsedaddrs :date);
+use Debbugs::Bugs qw(get_bugs);
 
-use vars qw($gPackagePages $gWebDomain);
+use vars qw($gPackagePages $gWebDomain %gSeverityDisplay @gSeverityList);
 
 if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') {
     print "Content-Type: text/html; charset=utf-8\n\n";
@@ -38,7 +37,7 @@ my $raw_sort = ($param{'raw'} || "no") eq "yes";
 my $old_view = ($param{'oldview'} || "no") eq "yes";
 unless (defined $ordering) {
    $ordering = "normal";
-   $ordering = "old" if $old_view;
+   $ordering = "oldview" if $old_view;
    $ordering = "raw" if $raw_sort;
 }
 
@@ -57,97 +56,6 @@ my $arch = $param{'arch'} || undef;
 my $show_list_header = ($param{'show_list_header'} || $userAgent->{'show_list_header'} || "yes" ) eq "yes";
 my $show_list_footer = ($param{'show_list_footer'} || $userAgent->{'show_list_footer'} || "yes" ) eq "yes";
 
-my @p = (
-  "pending:pending,forwarded,pending-fixed,fixed,done,absent",
-  "severity:critical,grave,serious,important,normal,minor,wishlist",
-  "pending=pending+tag=wontfix,pending=pending+tag=moreinfo,pending=pending+tag=patch,pending=pending+tag=confirmed,pending=pending");
-my @t = (
-  "Outstanding,Forwarded,Pending Upload,Fixed in NMU,Resolved,From other Branch,Unknown Pending Status",
-  "Critical,Grave,Serious,Important,Normal,Minor,Wishlist,Unknown Severity",
-  "Will Not Fix,More information needed,Patch Available,Confirmed,Unclassified");
-my @o = ("0,1,2,3,4,5,6","0,1,2,3,4,5,6,7","2,3,4,1,0,5");
-my @n = ("Status", "Severity", "Classification");
-
-if ($ordering eq "old") {
-    splice @p, 2, 1;
-    splice @t, 2, 1;
-    splice @o, 2, 1;
-    splice @n, 2, 1;
-}
-$o[0] = scalar reverse($o[0]) if ($pend_rev);
-$o[1] = scalar reverse($o[1]) if ($sev_rev);
-
-if (!defined $param{"pri0"} && $ordering =~ m/^user(\d+)$/) {
-    my $id = $1;
-    my $l = 0;
-    if (defined $param{"cat${id}_users"}) {
-        $users .= "," . $param{"cat${id}_users"};
-    }
-    while (defined $param{"cat${id}_nam$l"}) {
-        my ($n, $p, $t, $o) =
-           map { $param{"cat${id}_${_}$l"} || "" }
-               ("nam", "pri", "ttl", "ord");
-       if ($p eq "") {
-           if ($n eq "status") {
-               ($p, $t, $o) = ($p[0], $t[0], $o[0]);
-           } elsif ($n eq "severity") {
-               ($p, $t, $o) = ($p[1], $t[1], $o[1])
-           } else {
-                $ordering = "raw";
-               last;
-           }
-       }
-        $param{"nam$l"} = $n;
-        $param{"pri$l"} = $p;
-        $param{"ttl$l"} = $t;
-        $param{"ord$l"} = $o;
-       $l++;
-    }
-}
-if (defined $param{"pri0"}) {
-    my $i = 0;
-    @p = (); @o = (); @t = (); @n = ();
-    while (defined $param{"pri$i"}) {
-        push @p, $param{"pri$i"};
-       push @o, $param{"ord$i"} || "";
-       push @t, $param{"ttl$i"} || "";
-       push @n, $param{"nam$i"} || "";
-       $i++;
-    }
-}
-for my $x (@p) {
-    next if "$x," =~ m/^(pending|severity|tag):(([*]|[a-z0-9.-]+),)+$/;
-    next if "$x," =~ m/^((pending|severity|tag)=([*]|[a-z0-9.-]+)[,+])+/;
-    quitcgi("Bad syntax in Priority: $x");
-}
-
-my @names; my @prior; my @title; my @order;
-for my $i (0..$#p) {
-    push @prior, [ make_order_list($p[$i]) ];
-    if ($n[$i]) {
-       push @names, $n[$i];
-    } elsif ($p[$i] =~ m/^([^:]+):/) {
-        push @names, $1;
-    } else {
-        push @names, "Bug attribute #" . (1+$i);
-    }
-    if ($o[$i]) {
-        push @order, [ split /,/, $o[$i] ];
-    } else {
-        push @order, [ 0..$#{$prior[$i]} ];
-    }
-    my @t = split /,/, $t[$i];
-    push @t, map { toenglish($prior[$i]->[$_]) } ($#t+1)..($#{$prior[$i]});
-    push @title, [@t];
-}
-
-sub toenglish {
-    my $expr = shift;
-    $expr =~ s/[+]/ and /g;
-    $expr =~ s/[a-z]+=//g;
-    return $expr;
-}
-
 {
     if (defined $param{'vt'}) {
         my $vt = $param{'vt'};
@@ -169,14 +77,43 @@ sub toenglish {
 }
 
 
-my %bugusertags;
-my %ut;
-for my $user (split /[\s*,]+/, $users) {
-    next unless ($user =~ m/..../);
-    Debbugs::User::read_usertags(\%ut, $user);
-}
-
-my ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status, $tag, $usertag);
+my %hidden = map { $_, 1 } qw(status severity classification);
+my %cats = (
+    "status" => [ {
+        "nam" => "Status",
+        "pri" => [map { "pending=$_" }
+            qw(pending forwarded pending-fixed fixed done absent)],
+        "ttl" => ["Outstanding","Forwarded","Pending Upload",
+                  "Fixed in NMU","Resolved","From other Branch"],
+        "def" => "Unknown Pending Status",
+        "ord" => [0,1,2,3,4,5,6],
+    } ],
+    "severity" => [ {
+        "nam" => "Severity",
+        "pri" => [map { "severity=$_" } @gSeverityList],
+        "ttl" => [map { $gSeverityDisplay{$_} } @gSeverityList],
+        "def" => "Unknown Severity",
+        "ord" => [0..@gSeverityList],
+    } ],
+    "classification" => [ {
+        "nam" => "Classification",
+        "pri" => [qw(pending=pending+tag=wontfix 
+                     pending=pending+tag=moreinfo
+                     pending=pending+tag=patch
+                     pending=pending+tag=confirmed
+                     pending=pending)],
+        "ttl" => ["Will Not Fix","More information needed",
+                  "Patch Available","Confirmed"],
+        "def" => "Unclassified",
+        "ord" => [2,3,4,1,0,5],
+    } ],
+    "oldview" => [ qw(status severity) ],
+    "normal" => [ qw(status severity classification) ],
+);
+
+my ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status, $tag, $usertag,
+    $owner,
+   );
 
 my %which = (
         'pkg' => \$pkg,
@@ -187,6 +124,7 @@ my %which = (
         'severity' => \$severity,
         'tag' => \$tag,
        'usertag' => \$usertag,
+       'owner'   => \$owner,
         );
 my @allowedEmpty = ( 'maint' );
 
@@ -220,6 +158,13 @@ if (!$found) {
 }
 quitcgi("You have to choose something to select by") if (!$found);
 
+my %bugusertags;
+my %ut;
+for my $user (split /[\s*,]+/, $users) {
+    next unless length($user) >= 4;
+    add_user($user);
+}
+
 if (defined $usertag) {
     my %select_ut = ();
     my ($u, $t) = split /:/, $usertag, 2;
@@ -228,17 +173,10 @@ if (defined $usertag) {
         $t = join(",", keys(%select_ut));
     }
 
-    Debbugs::User::read_usertags(\%ut, $u);
+    add_user($u);
     $tag = $t;
 }
 
-for my $t (keys %ut) {
-    for my $b (@{$ut{$t}}) {
-        $bugusertags{$b} = [] unless defined $bugusertags{$b};
-        push @{$bugusertags{$b}}, $t;
-    }
-}
-
 my $Archived = $archive ? " Archived" : "";
 
 my $this = "";
@@ -246,10 +184,7 @@ my $this = "";
 my %indexentry;
 my %strings = ();
 
-$ENV{"TZ"} = 'UTC';
-tzset();
-
-my $dtime = strftime "%a, %e %b %Y %T UTC", localtime;
+my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
 my $tail_html = $debbugs::gHTMLTail;
 $tail_html = $debbugs::gHTMLTail;
 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
@@ -270,12 +205,52 @@ set_option("arch", $arch);
 set_option("use-bug-idx", defined($param{'use-bug-idx'}) ? $param{'use-bug-idx'} : 0);
 set_option("show_list_header", $show_list_header);
 set_option("show_list_footer", $show_list_footer);
-set_option("bugusertags", \%bugusertags);
 
+our %seen_users;
+sub add_user {
+    my $ut = \%ut;
+    my $u = shift;
+
+    return if $seen_users{$u};
+    $seen_users{$u} = 1;
+
+    my $user = Debbugs::User::get_user($u);
+
+    my %vis = map { $_, 1 } @{$user->{"visible_cats"}};
+    for my $c (keys %{$user->{"categories"}}) {
+        $cats{$c} = $user->{"categories"}->{$c};
+       $hidden{$c} = 1 unless defined $vis{$c};
+    }
+
+    for my $t (keys %{$user->{"tags"}}) {
+        $ut->{$t} = [] unless defined $ut->{$t};
+        push @{$ut->{$t}}, @{$user->{"tags"}->{$t}};
+    }
+
+    %bugusertags = ();
+    for my $t (keys %{$ut}) {
+        for my $b (@{$ut->{$t}}) {
+            $bugusertags{$b} = [] unless defined $bugusertags{$b};
+            push @{$bugusertags{$b}}, $t;
+        }
+    }
+    set_option("bugusertags", \%bugusertags);
+}
+
+my $pseudodesc = getpseudodesc();
+if (defined $pseudodesc and defined $pkg and exists $pseudodesc->{$pkg}) {
+     undef $dist;
+     set_option('dist',$dist)
+}
 my $title;
 my @bugs;
 if (defined $pkg) {
   $title = "package $pkg";
+  add_user("$pkg\@packages.debian.org");
+  # figure out the source package
+  my $pkgsrc = getpkgsrc();
+  add_user($pkgsrc->{$pkg}.'@packages.debian.org')
+       if defined $pkgsrc->{$pkg};
   if (defined $version) {
     $title .= " (version $version)";
   } elsif (defined $dist) {
@@ -284,13 +259,11 @@ if (defined $pkg) {
     $title .= " ($verdesc)" if defined $verdesc;
   }
   my @pkgs = split /,/, $pkg;
-  @bugs = @{getbugs(sub {my %d=@_;
-                         foreach my $try (splitpackages($d{"pkg"})) {
-                           return 1 if grep($try eq $_, @pkgs);
-                         }
-                         return 0;
-                        }, 'package', @pkgs)};
+  @bugs = get_bugs(package=>\@pkgs,
+                  archive=>$archive
+                 );
 } elsif (defined $src) {
+  add_user("$src\@packages.debian.org");
   $title = "source $src";
   set_option('arch', 'source');
   if (defined $version) {
@@ -300,45 +273,25 @@ if (defined $pkg) {
     my $verdesc = getversiondesc($src);
     $title .= " ($verdesc)" if defined $verdesc;
   }
-  my @pkgs = ();
-  my @srcs = split /,/, $src;
-  foreach my $try (@srcs) {
-    push @pkgs, getsrcpkgs($try);
-    push @pkgs, $try if ( !grep(/^\Q$try\E$/, @pkgs) );
-  }
-  @bugs = @{getbugs(sub {my %d=@_;
-                         foreach my $try (splitpackages($d{"pkg"})) {
-                           return 1 if grep($try eq $_, @pkgs);
-                         }
-                         return 0;
-                        }, 'package', @pkgs)};
+  @bugs = get_bugs(src=>[split /,/, $src],
+                  archive=>$archive
+                 );
 } elsif (defined $maint) {
-  my %maintainers = %{getmaintainers()};
+  add_user($maint);
   $title = "maintainer $maint";
   $title .= " in $dist" if defined $dist;
   if ($maint eq "") {
-    @bugs = @{getbugs(sub {my %d=@_;
-                           foreach my $try (splitpackages($d{"pkg"})) {
-                             return 1 if !getparsedaddrs($maintainers{$try});
-                           }
-                           return 0;
-                          })};
+       my %maintainers = %{getmaintainers()};
+       @bugs = @{getbugs(sub {my %d=@_;
+                             foreach my $try (splitpackages($d{"pkg"})) {
+                                  return 1 if !getparsedaddrs($maintainers{$try});
+                             }
+                             return 0;
+                        })};
   } else {
-    my @maints = split /,/, $maint;
-    my @pkgs = ();
-    foreach my $try (@maints) {
-      foreach my $p (keys %maintainers) {
-        my @me = getparsedaddrs($maintainers{$p});
-        push @pkgs, $p if grep { $_->address eq $try } @me;
-      }
-    }
-    @bugs = @{getbugs(sub {my %d=@_;
-                           foreach my $try (splitpackages($d{"pkg"})) {
-                             my @me = getparsedaddrs($maintainers{$try});
-                             return 1 if grep { $_->address eq $maint } @me;
-                           }
-                           return 0;
-                          }, 'package', @pkgs)};
+       @bugs = get_bugs(maint=>[map {lc ($_)} split /,/,$maint],
+                       archive=>$archive
+                      );
   }
 } elsif (defined $maintenc) {
   my %maintainers = %{getmaintainers()};
@@ -354,15 +307,13 @@ if (defined $pkg) {
                          return 0;
                         })};
 } elsif (defined $submitter) {
+  add_user($submitter);
   $title = "submitter $submitter";
   $title .= " in $dist" if defined $dist;
-  my @submitters = split /,/, $submitter;
-  @bugs = @{getbugs(sub {my %d=@_;
-                         my @se = getparsedaddrs($d{"submitter"} || "");
-                         foreach my $try (@submitters) {
-                           return 1 if grep { $_->address eq $try } @se;
-                         }
-                        }, 'submitter-email', @submitters)};
+  my @submitters = map {lc ($_)} split /,/, $submitter;
+  @bugs = get_bugs(submitter => \@submitters,
+                  archive=>$archive
+                 );
 } elsif (defined($severity) && defined($status)) {
   $title = "$status $severity bugs";
   $title .= " in $dist" if defined $dist;
@@ -395,6 +346,25 @@ if (defined $pkg) {
                          return grep(exists $tags{$_}, @tags);
                         })};
 }
+elsif (defined $owner) {
+     $title = "bugs owned by $owner";
+     $title .= " in $dist" if defined $dist;
+     my @owners = map {lc ($_)} split /,/, $owner;
+     my %bugs = ();
+     @bugs = get_bugs(owner=>\@owners,
+                     archive=>$archive
+                    );
+
+}
+$title = htmlsanit($title);
+
+my @names; my @prior; my @title; my @order;
+determine_ordering();
+
+# strip out duplicate bugs
+my %bugs;
+@bugs{@bugs} = @bugs;
+@bugs = keys %bugs;
 
 my $result = pkg_htmlizebugs(\@bugs);
 
@@ -402,18 +372,18 @@ print "Content-Type: text/html; charset=utf-8\n\n";
 
 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
 print "<HTML><HEAD>\n" . 
-    "<TITLE>$debbugs::gProject$Archived $debbugs::gBug report logs: $title</TITLE>\n" .
-    '<link rel="stylesheet" href="/css/bugs.css" type="text/css">' .
+    "<TITLE>$title -- $gProject$Archived $gBug report logs</TITLE>\n" .
+    qq(<link rel="stylesheet" href="$gWebHostBugDir/css/bugs.css" type="text/css">) .
     "</HEAD>\n" .
     '<BODY onload="pagemain();">' .
     "\n";
-print "<H1>" . "$debbugs::gProject$Archived $debbugs::gBug report logs: $title" .
+print "<H1>" . "$gProject$Archived $gBug report logs: $title" .
       "</H1>\n";
 
 my $showresult = 1;
 
 if (defined $pkg || defined $src) {
-    my $showpkg = (defined $pkg) ? $pkg : "source package $src";
+    my $showpkg = htmlsanit((defined $pkg) ? $pkg : "source package $src");
     my %maintainers = %{getmaintainers()};
     my $maint = $pkg ? $maintainers{$pkg} : $maintainers{$src} ? $maintainers{$src} : undef;
     if (defined $maint) {
@@ -452,30 +422,27 @@ if (defined $pkg || defined $src) {
         if ($pkg and defined($pseudodesc) and exists($pseudodesc->{$pkg})) {
             push @references, "to the <a href=\"http://${debbugs::gWebDomain}/pseudo-packages${debbugs::gHTMLSuffix}\">list of other pseudo-packages</a>";
         } else {
-            if ($pkg and defined $debbugs::gPackagePages) {
+            if ($pkg and defined $gPackagePages) {
                 push @references, sprintf "to the <a href=\"%s\">%s package page</a>", urlsanit("http://${debbugs::gPackagePages}/$pkg"), htmlsanit("$pkg");
             }
-            if (defined $debbugs::gSubscriptionDomain) {
+            if (defined $gSubscriptionDomain) {
                 my $ptslink = $pkg ? $srcforpkg : $src;
-                push @references, "to the <a href=\"http://$debbugs::gSubscriptionDomain/$ptslink\">Package Tracking System</a>";
+                push @references, "to the <a href=\"http://$gSubscriptionDomain/$ptslink\">Package Tracking System</a>";
             }
             # Only output this if the source listing is non-trivial.
             if ($pkg and $srcforpkg and (@pkgs or $pkg ne $srcforpkg)) {
                 push @references, sprintf "to the source package <a href=\"%s\">%s</a>'s bug page", srcurl($srcforpkg), htmlsanit($srcforpkg);
             }
         }
-        if ($pkg) {
-            set_option("archive", !$archive);
-            push @references, sprintf "to the <a href=\"%s\">%s reports for %s</a>", pkgurl($pkg), ($archive ? "active" : "archived"), htmlsanit($pkg);
-            set_option("archive", $archive);
-        }
         if (@references) {
             $references[$#references] = "or $references[$#references]" if @references > 1;
             print "<p>You might like to refer ", join(", ", @references), ".</p>\n";
         }
-        print "<p>If you find a bug not listed here, please\n";
-        printf "<a href=\"%s\">report it</a>.</p>\n",
-               urlsanit("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}");
+       if (defined $maint || defined $maintenc) {
+            print "<p>If you find a bug not listed here, please\n";
+            printf "<a href=\"%s\">report it</a>.</p>\n",
+                 urlsanit("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}");
+       }
     } else {
         print "<p>There is no record of the " .
               (defined($pkg) ? htmlsanit($pkg) . " package"
@@ -493,6 +460,18 @@ if (defined $pkg || defined $src) {
     print "different addresses.\n";
 }
 
+set_option("archive", !$archive);
+printf "<p>See the <a href=\"%s\">%s reports</a></p>",
+     urlsanit(pkg_url((
+                      map {
+                           $_ eq 'archive'?():($_,$param{$_})
+                      } keys %param
+                     ),
+                     ('archive',($archive?"no":"yes"))
+                    )
+            ), ($archive ? "active" : "archived");
+set_option("archive", $archive);
+
 print $result if $showresult;
 
 print pkg_javascript() . "\n";
@@ -517,27 +496,29 @@ print "<tr><td></td>";
 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";
 
 if (defined $pkg) {
-    my $v = $version || "";
+    my $v = htmlsanit($version) || "";
+    my $pkgsane = htmlsanit($pkg);
     print "<tr><td></td>";
-    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";
+    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";
 } elsif (defined $src) {
-    my $v = $version || "";
+    my $v = htmlsanit($version) || "";
+    my $srcsane = htmlsanit($src);
     print "<tr><td></td>";
-    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";
+    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";
 }
 print "<tr><td>&nbsp;</td></tr>\n";
 
-my $includetags = join(" ", grep { !m/^subj:/i } split /[\s,]+/, $include);
-my $excludetags = join(" ", grep { !m/^subj:/i } split /[\s,]+/, $exclude);
-my $includesubj = join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } split /[\s,]+/, $include);
-my $excludesubj = join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } split /[\s,]+/, $exclude);
+my $includetags = htmlsanit(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include));
+my $excludetags = htmlsanit(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude));
+my $includesubj = htmlsanit(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include));
+my $excludesubj = htmlsanit(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude));
 my $vismindays = ($mindays == 0 ? "" : $mindays);
 my $vismaxdays = ($maxdays == -1 ? "" : $maxdays);
 
 my $sel_rmy = ($repeatmerged ? " selected" : "");
 my $sel_rmn = ($repeatmerged ? "" : " selected");
 my $sel_ordraw = ($ordering eq "raw" ? " selected" : "");
-my $sel_ordold = ($ordering eq "old" ? " selected" : "");
+my $sel_ordold = ($ordering eq "oldview" ? " selected" : "");
 my $sel_ordnor = ($ordering eq "normal" ? " selected" : "");
 
 my $chk_bugrev = ($bug_rev ? " checked" : "");
@@ -560,22 +541,27 @@ print <<EOF;
 <tr><td>Categorise bugs by</td><td>
 <select name=ordering>
 <option value=raw$sel_ordraw>bug number only</option>
-<option value=old$sel_ordold>status, and severity</option>
+<option value=old$sel_ordold>status and severity</option>
 <option value=normal$sel_ordnor>status, severity and classification</option>
 EOF
 
 {
 my $any = 0;
 my $o = $param{"ordering"} || "";
-for my $i (1..$cats) {
-    my $n = get_cat_name($i);
-    next unless defined $n;
+for my $n (keys %cats) {
+    next if ($n eq "normal" || $n eq "oldview");
+    next if defined $hidden{$n};
     unless ($any) {
         $any = 1;
-       print "<option disabled>------</option\n";
+       print "<option disabled>------</option>\n";
     }
-    printf "<option value=user%s%s>%s</option>\n",
-        $i, ($o eq "user$i" ? " selected" : ""), $n;
+    my @names = map { ref($_) eq "HASH" ? $_->{"nam"} : $_ } @{$cats{$n}};
+    my $name;
+    if (@names == 1) { $name = $names[0]; }
+    else { $name = " and " . pop(@names); $name = join(", ", @names) . $name; }
+
+    printf "<option value=\"%s\"%s>%s</option>\n",
+        $n, ($o eq $n ? " selected" : ""), $name;
 }
 }
 
@@ -595,77 +581,6 @@ EOF
 
 print "</table></form></div>\n";
 
-print "<h2 class=\"outstanding\"><a class=\"options\" href=\"javascript:toggle(2)\">User Categorisations (beta)</a></h2>\n";
-print "<div id=\"a_2\">\n";
-print <<EOF;
-<p>This form allows you to define a new categorisation to use to view bugs
-against packages. Once defined it will show up as an available category
-in the Options section above. Note there are a limited numbering of
-categorisations you can define, so you may need to choose a pre-existing
-categorisation to replace. Note that this feature currently requires both
-Javascript and cookies to be enabled. Some usage information is available
-via Anthony Towns' <a href="http://code.erisian.com.au/Wiki/debbugs/SectioningNotes">development notes</a>.
-</p>
-EOF
-
-printf "<form name=\"categories\" action=\"%s\" method=POST>\n", myurl();
-print "<table class=\"forms\">\n";
-
-sub get_cat_name {
-    my $i = shift;
-    if (defined $param{"cat${i}_nam0"}) {
-        my @nams = ();
-       my $j = 0;
-       while (defined $param{"cat${i}_nam$j"}) {
-           push @nams, $param{"cat${i}_nam$j"};
-           $j++;
-       }
-       return join(", ", @nams);
-    } else {
-        return undef;
-    }
-}
-
-print "<tr><td>Categorisation to set</td><td>\n";
-print "<select name=categorisation>\n";
-my $default = 1;
-for my $i (1..$cats) {
-    my $name = get_cat_name($i);
-    unless (defined $name) {
-        $name = "(unused)";
-        $default = $i if $default == 0;
-    }
-    printf "<option value=%s%s>%s. %s</option>\n",
-        $i, ($default == $i ? " selected" : ""), $i, $name;
-}
-my $defusers = $param{"cat${default}_users"} || $users;
-print "</select></td></tr>\n";
-print "<tr><td>Include usertags set by</td><td>\n";
-print "<input id=users size=50 value=\"$defusers\"></td></tr>\n";
-print "<tr><td>&nbsp;</td></tr>\n";
-
-for my $level (0..3) {
-    my $hlevel = $level + 1;
-    my ($n, $s, $t, $o) =
-        map { $param{"cat${default}_${_}${level}"} || "" }
-           ("nam", "pri", "ttl", "ord");
-
-    print <<EOF;
-<tr><td>Level</td><td>$hlevel</td></tr>
-<tr><td>Name</td><td><input id="nam$level" value="$n"></td></tr>
-<tr><td>Sections</td><td><input id="pri$level" value="$s" size=70></td></tr>
-<tr><td>Titles</td><td><input id="ttl$level" value="$t" size=70></td></tr>
-<tr><td>Ordering</td><td><input id="ord$level" value="$o" size=20></td></tr>
-<tr><td>&nbsp;</td></tr>
-EOF
-}
-    
-print <<EOF;
-<tr><td colspan=2><a href="javascript:save_cat_cookies();">Commit new ordering</a></td></tr>
-EOF
-
-print "</table></form></div>\n";
-
 print "<hr>\n";
 print "<p>$tail_html";
 
@@ -691,19 +606,19 @@ sub pkg_htmlindexentrystatus {
     my $showversions = '';
     if (@{$status{found_versions}}) {
         my @found = @{$status{found_versions}};
-        local $_;
-        s{/}{ } foreach @found;
-        $showversions .= join ', ', map htmlsanit($_), @found;
+        $showversions .= join ', ', map {s{/}{ }; htmlsanit($_)} @found;
     }
     if (@{$status{fixed_versions}}) {
         $showversions .= '; ' if length $showversions;
         $showversions .= '<strong>fixed</strong>: ';
         my @fixed = @{$status{fixed_versions}};
-        local $_;
-        s{/}{ } foreach @fixed;
-        $showversions .= join ', ', map htmlsanit($_), @fixed;
+        $showversions .= join ', ', map {s{/}{ }; htmlsanit($_)} @fixed;
     }
-    $result .= " ($showversions)" if length $showversions;
+    $result .= ' (<a href="'.
+        version_url($status{package},
+                    $status{found_versions},
+                    $status{fixed_versions},
+                   ).qq{">$showversions</a>)} if length $showversions;
     $result .= ";\n";
 
     $result .= $showseverity;
@@ -716,50 +631,56 @@ sub pkg_htmlindexentrystatus {
                  . "</strong>"
                        if (length($status{tags}));
 
-    my @merged= split(/ /,$status{mergedwith});
-    my $mseparator= ";\nMerged with ";
-    for my $m (@merged) {
-        $result .= $mseparator."<A class=\"submitter\" href=\"" . bugurl($m) . "\">#$m</A>";
-        $mseparator= ", ";
-    }
+    $result .= buglinklist(";\nMerged with ", ", ",
+        split(/ /,$status{mergedwith}));
+    $result .= buglinklist(";\nBlocked by ", ", ",
+        split(/ /,$status{blockedby}));
+    $result .= buglinklist(";\nBlocks ", ", ",
+        split(/ /,$status{blocks}));
 
-    my $days = 0;
     if (length($status{done})) {
         $result .= "<br><strong>Done:</strong> " . htmlsanit($status{done});
-        $days = ceil($debbugs::gRemoveAge - -M buglog($status{id}));
-        if ($days >= 0) {
+        my $days = bug_archiveable(bug => $status{id},
+                                  status => \%status,
+                                  days_until => 1,
+                                 );
+        if ($days >= 0 and $status->{location} ne 'archive') {
             $result .= ";\n<strong>Will be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
-        } else {
-            $result .= ";\n<strong>Archived</strong>";
         }
     }
 
     unless (length($status{done})) {
         if (length($status{forwarded})) {
             $result .= ";\n<strong>Forwarded</strong> to "
-                       . maybelink($status{forwarded});
+                       . join(', ',
+                             map {maybelink($_)}
+                             split /[,\s]+/,$status{forwarded}
+                            );
         }
-        my $daysold = int((time - $status{date}) / 86400);   # seconds to days
-        if ($daysold >= 7) {
+       # 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 ($daysold > 30);
-            $font = "strong" if ($daysold > 60);
+            $font = "em" if ($days > 30);
+            $font = "strong" if ($days > 60);
             $efont = "</$font>" if ($font);
             $font = "<$font>" if ($font);
 
-            my $yearsold = int($daysold / 365);
-            $daysold -= $yearsold * 365;
-
-            $result .= ";\n $font";
-            my @age;
-            push @age, "1 year" if ($yearsold == 1);
-            push @age, "$yearsold years" if ($yearsold > 1);
-            push @age, "1 day" if ($daysold == 1);
-            push @age, "$daysold days" if ($daysold > 1);
-            $result .= join(" and ", @age);
-            $result .= " old$efont";
+            $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 .= ".";
@@ -777,7 +698,7 @@ sub pkg_htmlizebugs {
     my $header = '';
     my $footer = "<h2 class=\"outstanding\">Summary</h2>\n";
 
-    my @dummy = ($debbugs::gRemoveAge); #, @debbugs::gSeverityList, @debbugs::gSeverityDisplay);  #, $debbugs::gHTMLExpireNote);
+    my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay);  #, $gHTMLExpireNote);
 
     if (@bugs == 0) {
         return "<HR><H2>No reports found!</H2></HR>\n";
@@ -809,7 +730,6 @@ sub pkg_htmlizebugs {
         my $key = "";
        for my $i (0..$#prior) {
            my $v = get_bug_order_index($prior[$i], \%status);
-           my $k = $prior[$i]->[$v];
             $count{"g_${i}_${v}"}++;
            $key .= "_$v";
        }
@@ -829,20 +749,21 @@ sub pkg_htmlizebugs {
            push @keys_in_order, "X";
            while ((my $k = shift @keys_in_order) ne "X") {
                for my $k2 (@{$o}) {
+                   $k2+=0;
                    push @keys_in_order, "${k}_${k2}";
                }
            }
        }
-        for ( my $i = 0; $i <= $#keys_in_order; $i++ ) {
-            my $order = $keys_in_order[ $i ];
+        for my $order (@keys_in_order) {
             next unless defined $section{$order};
            my @ttl = split /_/, $order; shift @ttl;
            my $title = $title[0]->[$ttl[0]] . " bugs";
            if ($#ttl > 0) {
                $title .= " -- ";
-               $title .= join("; ", grep {$_ ne ""}
+               $title .= join("; ", grep {($_ || "") ne ""}
                        map { $title[$_]->[$ttl[$_]] } 1..$#ttl);
            }
+           $title = htmlsanit($title);
 
             my $count = $count{"_$order"};
             my $bugs = $count == 1 ? "bug" : "bugs";
@@ -903,20 +824,7 @@ sub pkg_htmlpackagelinks {
 }
 
 sub pkg_htmladdresslinks {
-    my ($prefixfunc, $urlfunc, $addresses) = @_;
-    if (defined $addresses and $addresses ne '') {
-        my @addrs = getparsedaddrs($addresses);
-        my $prefix = (ref $prefixfunc) ? $prefixfunc->(scalar @addrs)
-                                       : $prefixfunc;
-        return $prefix .
-               join ', ', map { sprintf '<a class="submitter" href="%s">%s</a>',
-                                        $urlfunc->($_->address),
-                                        htmlsanit($_->format) || '(unknown)'
-                              } @addrs;
-    } else {
-        my $prefix = (ref $prefixfunc) ? $prefixfunc->(1) : $prefixfunc;
-        return sprintf '%s<a class="submitter" href="%s">(unknown)</a>', $prefix, $urlfunc->('');
-    }
+     htmlize_addresslinks(@_,'submitter');
 }
 
 sub pkg_javascript {
@@ -925,7 +833,7 @@ sub pkg_javascript {
 <!--
 function pagemain() {
        toggle(1);
-       toggle(2);
+//     toggle(2);
        enable(1);
 }
 
@@ -974,10 +882,12 @@ function save_cat_cookies() {
 
 function toggle(i) {
         var a = document.getElementById("a_" + i);
-        if (a.style.display == "none") {
-                a.style.display = "";
-        } else {
-                a.style.display = "none";
+        if (a) {
+             if (a.style.display == "none") {
+                     a.style.display = "";
+             } else {
+                     a.style.display = "none";
+             }
         }
 }
 
@@ -1037,12 +947,11 @@ sub pkg_htmlselectarch {
 }
 
 sub myurl {
-    return pkg_etc_url($pkg, "pkg", 0) if defined($pkg);
-    return pkg_etc_url($src, "src", 0) if defined($src);
-    return pkg_etc_url($maint, "maint", 0) if defined($maint);
-    return pkg_etc_url($submitter, "submitter", 0) if defined($submitter);
-    return pkg_etc_url($severity, "severity", 0) if defined($severity);
-    return pkg_etc_url($tag, "tag", 0) if defined($tag);
+     return urlsanit(pkg_url(map {exists $param{$_}?($_,$param{$_}):()}
+                            qw(archive repeatmerged mindays maxdays),
+                            qw(version dist arch pkg src tag maint submitter)
+                           )
+                   );
 }
 
 sub make_order_list {
@@ -1092,6 +1001,92 @@ sub get_bug_order_index {
             last;
         }
     }
-    return -1;
+    return $pos + 1;
+}
+
+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 {
+    $cats{status}[0]{ord} = [ reverse @{$cats{status}[0]{ord}} ]
+        if ($pend_rev);
+    $cats{severity}[0]{ord} = [ reverse @{$cats{severity}[0]{ord}} ]
+        if ($sev_rev);
+
+    my $i;
+    if (defined $param{"pri0"}) {
+        my @c = ();
+        $i = 0;
+        while (defined $param{"pri$i"}) {
+            my $h = {};
+
+            my $pri = $param{"pri$i"};
+            if ($pri =~ m/^([^:]*):(.*)$/) {
+              $h->{"nam"} = $1;  # overridden later if necesary
+              $h->{"pri"} = [ map { "$1=$_" } (split /,/, $2) ];
+            } else {
+              $h->{"pri"} = [ split /,/, $pri ];
+            }
+
+           $h->{"nam"} = $param{"nam$i"}
+                if (defined $param{"nam$i"}); 
+            $h->{"ord"} = [ split /\s*,\s*/, $param{"ord$i"} ]
+                if (defined $param{"ord$i"}); 
+            $h->{"ttl"} = [ split /\s*,\s*/, $param{"ttl$i"} ]
+                if (defined $param{"ttl$i"}); 
+
+            push @c, $h;
+           $i++;
+        }
+        $cats{"_"} = [@c];
+        $ordering = "_";
+    }
+
+    $ordering = "normal" unless defined $cats{$ordering};
+
+    sub get_ordering {
+        my @res;
+       my $cats = shift;
+        my $o = shift;
+        for my $c (@{$cats->{$o}}) {
+            if (ref($c) eq "HASH") {
+                push @res, $c;
+            } else {
+                push @res, get_ordering($cats, $c);
+            }
+        }
+        return @res;
+    }
+    my @cats = get_ordering(\%cats, $ordering);
+
+    sub toenglish {
+        my $expr = shift;
+        $expr =~ s/[+]/ and /g;
+        $expr =~ s/[a-z]+=//g;
+        return $expr;
+    }
+    $i = 0;
+    for my $c (@cats) {
+       $i++;
+        push @prior, $c->{"pri"};
+       push @names, ($c->{"nam"} || "Bug attribute #" . $i);
+        if (defined $c->{"ord"}) {
+            push @order, $c->{"ord"};
+        } else {
+            push @order, [ 0..$#{$prior[-1]} ];
+        }
+        my @t = @{ $c->{"ttl"} } if defined $c->{ttl};
+       if (@t < $#{$prior[-1]}) {
+            push @t, map { toenglish($prior[-1][$_]) } @t..($#{$prior[-1]});
+       }
+       push @t, $c->{"def"} || "";
+        push @title, [@t];
+    }
+}