[project @ 2003-06-25 17:51:51 by cjwatson]

[debbugs.git] / cgi / common.pl

diff --git a/cgi/common.pl b/cgi/common.pl
index 09bc85798aad1ac8219331f709ed6815233dfb76..ed9728e108d320f7614b12ea936836696e514e02 100644 (file)
--- a/cgi/common.pl
+++ b/cgi/common.pl
@@ -2,6 +2,7 @@
 
 use DB_File;
 use Fcntl qw/O_RDONLY/;
+use Mail::Address;
 $config_path = '/etc/debbugs';
 $lib_path = '/usr/lib/debbugs';
 require "$lib_path/errorlib";
@@ -129,7 +130,16 @@ sub quitcgi {
 sub splitpackages {
     my $pkgs = shift;
     return unless defined $pkgs;
-    return split /[ \t?,()]+/, $pkgs;
+    return map lc, split /[ \t?,()]+/, $pkgs;
+}
+
+my %_parsedaddrs;
+sub getparsedaddrs {
+    my $addr = shift;
+    return () unless defined $addr;
+    return @{$_parsedaddrs{$addr}} if exists $_parsedaddrs{$addr};
+    @{$_parsedaddrs{$addr}} = Mail::Address->parse($addr);
+    return @{$_parsedaddrs{$addr}};
 }
 
 # Generate a comma-separated list of HTML links to each package given in
@@ -153,6 +163,25 @@ sub htmlpackagelinks {
            ) . ";\n";
 }
 
+# Generate a comma-separated list of HTML links to each maintainer given in
+# $maints, which should be a comma-separated list of RFC822 addresses.
+sub htmlmaintlinks {
+    my ($prefixfunc, $maints) = @_;
+    if (defined $maints and $maints ne '') {
+        my @maintaddrs = getparsedaddrs($maints);
+        my $prefix = (ref $prefixfunc) ? $prefixfunc->(scalar @maintaddrs)
+                                       : $prefixfunc;
+        return $prefix .
+               join ', ', map { sprintf '<a href="%s">%s</a>',
+                                        mainturl($_->address),
+                                        htmlsanit($_->format) || '(unknown)'
+                              } @maintaddrs;
+    } else {
+        my $prefix = (ref $prefixfunc) ? $prefixfunc->(1) : $prefixfunc;
+        return sprintf '%s<a href="%s">(unknown)</a>', $prefix, mainturl('');
+    }
+}
+
 sub htmlindexentry {
     my $ref = shift;
     my %status = %{getbugstatus($ref)};
@@ -206,8 +235,8 @@ sub htmlindexentrystatus {
             $efont = "</$font>" if ($font);
             $font = "<$font>" if ($font);
 
-            my $yearsold = int($daysold / 364);
-            $daysold = $daysold - $yearsold * 364;
+            my $yearsold = int($daysold / 365);
+            $daysold -= $yearsold * 365;
 
             $result .= ";\n $font";
             my @age;
@@ -305,8 +334,10 @@ sub dlurl {
        $filename = $1 if ($val =~ /^filename=(.*)$/);
     }
     $params .= "&archive=yes" if ($common_archive);
+    my $pathinfo = '';
+    $pathinfo = "/$filename" if $filename ne '';
 
-    return urlsanit("bugreport.cgi/$filename?$params");
+    return urlsanit("bugreport.cgi$pathinfo?$params");
 }
 
 sub mboxurl {
@@ -315,15 +346,7 @@ sub mboxurl {
 }
 
 sub allbugs {
-    my @bugs = ();
-
-    opendir(D, "$debbugs::gSpoolDir/db") or &quitcgi("opendir db: $!");
-    @bugs = sort {$a<=>$b} grep s/\.status$//,
-                (grep m/^[0-9]+\.status$/,
-                (readdir(D)));
-    closedir(D);
-
-    return @bugs;
+    return @{getbugs(sub { 1 })};
 }
 
 sub htmlizebugs {
@@ -348,11 +371,10 @@ sub htmlizebugs {
     } else {
        @bugs = sort {$a<=>$b} @bugs;
     }
+    my %seenmerged;
     foreach my $bug (@bugs) {
        my %status = %{getbugstatus($bug)};
         next unless %status;
-       my @merged = sort {$a<=>$b} ($bug, split(/ /, $status{mergedwith}));
-       next unless ($common_repeatmerged || $bug == $merged[0]);
        if (%common_include) {
            my $okay = 0;
            foreach my $t (split /\s+/, $status{tags}) {
@@ -384,6 +406,10 @@ sub htmlizebugs {
        next if grep { $_ eq $status{pending} } @common_pending_exclude;
        next if grep { $_ eq $status{severity} } @common_severity_exclude;
 
+       my @merged = sort {$a<=>$b} ($bug, split(/ /, $status{mergedwith}));
+       next unless ($common_repeatmerged || !$seenmerged{$merged[0]});
+       $seenmerged{$merged[0]} = 1;
+
        my $html = sprintf "<li><a href=\"%s\">#%d: %s</a>\n<br>",
            bugurl($bug), $bug, htmlsanit($status{subject});
        $html .= htmlindexentrystatus(\%status) . "\n";
@@ -427,9 +453,11 @@ sub htmlizebugs {
 sub countbugs {
     my $bugfunc = shift;
     if ($common_archive) {
-        open I, "<$debbugs::gSpoolDir/index.archive" or &quitcgi("bugindex: $!");
+        open I, "<$debbugs::gSpoolDir/index.archive"
+            or &quitcgi("$debbugs::gSpoolDir/index.archive: $!");
     } else {
-        open I, "<$debbugs::gSpoolDir/index.db" or &quitcgi("bugindex: $!");
+        open I, "<$debbugs::gSpoolDir/index.db"
+            or &quitcgi("$debbugs::gSpoolDir/index.db: $!");
     }
 
     my %count = ();
@@ -470,10 +498,10 @@ print STDERR "done optimized\n" if ($debug);
     } else {
         if ( $common_archive ) {
             open I, "<$debbugs::gSpoolDir/index.archive" 
-                or &quitcgi("bugindex: $!");
+                or &quitcgi("$debbugs::gSpoolDir/index.archive: $!");
         } else {
             open I, "<$debbugs::gSpoolDir/index.db" 
-                or &quitcgi("bugindex: $!");
+                or &quitcgi("$debbugs::gSpoolDir/index.db: $!");
         }
         while(<I>) {
             if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
@@ -528,14 +556,16 @@ sub getmaintainers {
        $maintainer{$a}= $b;
     }
     close(MM);
-    open(MM,"$gMaintainerFileOverride") or &quitcgi("open $gMaintainerFileOverride: $!");
-    while(<MM>) {
-       next unless m/^(\S+)\s+(\S.*\S)\s*$/;
-       ($a,$b)=($1,$2);
-       $a =~ y/A-Z/a-z/;
-       $maintainer{$a}= $b;
+    if (defined $gMaintainerFileOverride) {
+       open(MM,"$gMaintainerFileOverride") or &quitcgi("open $gMaintainerFileOverride: $!");
+       while(<MM>) {
+           next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+           ($a,$b)=($1,$2);
+           $a =~ y/A-Z/a-z/;
+           $maintainer{$a}= $b;
+       }
+       close(MM);
     }
-    close(MM);
     $_maintainer = \%maintainer;
     return $_maintainer;
 }
@@ -544,6 +574,7 @@ my $_pkgsrc;
 my $_pkgcomponent;
 sub getpkgsrc {
     return $_pkgsrc if $_pkgsrc;
+    return {} unless defined $gPackageSource;
     my %pkgsrc;
     my %pkgcomponent;
 
@@ -619,11 +650,8 @@ sub getsrcpkgs {
    
 sub buglog {
     my $bugnum = shift;
-
-    my $dir = getlocationpath( getbuglocation( $bugnum, "log" ) );
-    my $hash = get_hashname( $bugnum );
-    return "" if ( !$dir );
-    return "$dir/$hash/$bugnum.log";
+    my $location = getbuglocation($bugnum, 'log');
+    return getbugcomponent($bugnum, 'log', $location);
 }
 
 1;