]> git.donarmstrong.com Git - debbugs.git/blobdiff - cgi/pkgreport.cgi
[project @ 2001-11-22 01:47:41 by doogie]
[debbugs.git] / cgi / pkgreport.cgi
index b9c854b161a325f5b70bb77ceb58bb52f4e4eaa5..d2d933994fe39486a32ba9a657010ace5c976a5b 100755 (executable)
@@ -5,59 +5,76 @@ package debbugs;
 use strict;
 use POSIX qw(strftime tzset nice);
 
-require '/debian/home/ajt/newajbug/common.pl';
-#require '/usr/lib/debbugs/common.pl';
 #require '/usr/lib/debbugs/errorlib';
+require './common.pl';
 
 require '/etc/debbugs/config';
 require '/etc/debbugs/text';
 
 nice(5);
 
-sub readparse {
-        my ($in, $key, $val, %ret);
-        if (defined $ENV{"QUERY_STRING"} && $ENV{"QUERY_STRING"} ne "") {
-                $in=$ENV{QUERY_STRING};
-        } elsif(defined $ENV{"REQUEST_METHOD"}
-                && $ENV{"REQUEST_METHOD"} eq "POST")
-        {
-                read(STDIN,$in,$ENV{CONTENT_LENGTH});
-        } else {
-                return;
-        }
-        foreach (split(/&/,$in)) {
-                s/\+/ /g;
-                ($key, $val) = split(/=/,$_,2);
-                $key=~s/%(..)/pack("c",hex($1))/ge;
-                $val=~s/%(..)/pack("c",hex($1))/ge;
-                $ret{$key}=$val;
-        }
-        return %ret;
-}
-
 my %param = readparse();
 
-my ($pkg, $maint, $maintenc, $submitter, $severity, $status);
-
-if (defined ($pkg = $param{'pkg'})) {
-} elsif (defined ($maint = $param{'maint'})) {
-} elsif (defined ($maintenc = $param{'maintenc'})) {
-} elsif (defined ($submitter= $param{'submitter'})) { 
-} elsif (defined ($severity = $param{'severity'})) { 
-       $status = $param{'status'} || 'open';
-} else {
-       quit("You have to choose something to select by");
+my ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status);
+
+my %which = (
+       'pkg' => \$pkg,
+       'src' => \$src,
+       'maint' => \$maint,
+       'maintenc' => \$maintenc,
+       'submitter' => \$submitter,
+       'severity' => \$severity,
+       );
+my @allowedEmpty = ( 'maint' );
+
+my $found;
+foreach ( keys %which ) {
+       $status = $param{'status'} || 'open' if /^severity$/;
+       if (($found = $param{$_})) {
+               ${ $which{$_} } = $found;
+               last;
+       }
+}
+if (!$found) {
+       foreach ( @allowedEmpty ) {
+               if (exists($param{$_})) {
+                       ${ $which{$_} } = '';
+                       $found = 1;
+                       last;
+               }
+       }
+}
+if (!$found) {
+       my $which;
+       if (($which = $param{'which'})) {
+               if (grep( /^\Q$which\E$/, @allowedEmpty)) {
+                       ${ $which{$which} } = $param{'data'};
+                       $found = 1;
+               } elsif (($found = $param{'data'})) {
+                       ${ $which{$which} } = $found if (exists($which{$which}));
+               }
+       }
 }
+quit("You have to choose something to select by") if (!$found);
 
 my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes";
 my $archive = ($param{'archive'} || "no") eq "yes";
-
-my $Archived = $archive ? "Archived" : "";
+my $include = $param{'include'} || "";
+my $exclude = $param{'exclude'} || "";
+my $raw_sort = ($param{'raw'} || "no") eq "yes";
+my $bug_rev = ($param{'bug-rev'} || "no") eq "yes";
+my $pend_rev = ($param{'pend-rev'} || "no") eq "yes";
+my $sev_rev = ($param{'sev-rev'} || "no") eq "yes";
+my $pend_exc = $param{'&pend-exc'} || $param{'pend-exc'} || "";
+my $pend_inc = $param{'&pend-inc'} || $param{'pend-inc'} || "";
+my $sev_exc = $param{'&sev-exc'} || $param{'sev-exc'} || "";
+my $sev_inc = $param{'&sev-inc'} || $param{'sev-inc'} || "";
+
+my $Archived = $archive ? " Archived" : "";
 
 my $this = "";
 
 my %indexentry;
-my %maintainer = &getmaintainers();
 my %strings = ();
 
 $ENV{"TZ"} = 'UTC';
@@ -68,57 +85,120 @@ my $tail_html = $debbugs::gHTMLTail;
 $tail_html = $debbugs::gHTMLTail;
 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
 
-my $tag;
-if (defined $pkg) {
-    $tag = "package $pkg";
-} elsif (defined $maint) {
-    $tag = "maintainer $maint";
-} elsif (defined $maintenc) {
-    $tag = "encoded maintainer $maintenc";
-} elsif (defined $submitter) {
-    $tag = "submitter $submitter";
-} elsif (defined $severity) {
-    $tag = "$status $severity bugs";
-}
-
 set_option("repeatmerged", $repeatmerged);
 set_option("archive", $archive);
+set_option("include", { map {if (m/^(.*):(.*)$/) { ($1,$2) } else { ($_,1) }} (split /[\s,]+/, $include) })
+       if ($include);
+set_option("exclude", { map {if (m/^(.*):(.*)$/) { ($1,$2) } else { ($_,1) }} (split /[\s,]+/, $exclude) })
+       if ($exclude);
+set_option("raw", $raw_sort);
+set_option("bug-rev", $bug_rev);
+set_option("pend-rev", $pend_rev);
+set_option("sev-rev", $sev_rev);
+set_option("pend-exc", $pend_exc);
+set_option("pend-inc", $pend_inc);
+set_option("sev-exc", $sev_exc);
+set_option("sev-inc", $sev_inc);
 
+my $tag;
 my @bugs;
 if (defined $pkg) {
-    @bugs = pkgbugs($pkg);
+  $tag = "package $pkg";
+  @bugs = @{getbugs(sub {my %d=@_; return $pkg eq $d{"pkg"}}, 'package', $pkg)};
+} elsif (defined $src) {
+  $tag = "source $src";
+  my @pkgs = getsrcpkgs($src);
+  push @pkgs, $src if ( !grep(/^\Q$src\E$/, @pkgs) );
+  @bugs = @{getbugs(sub {my %d=@_; return $pkg eq $d{"pkg"}}, 'package', @pkgs)};
 } elsif (defined $maint) {
-    @bugs = maintbugs($maint);
+  my %maintainers = %{getmaintainers()};
+  $tag = "maintainer $maint";
+  my @pkgs = ();
+  foreach my $p (keys %maintainers) {
+    my $me = $maintainers{$p};
+    $me =~ s/\s*\(.*\)\s*//;
+    $me = $1 if ($me =~ m/<(.*)>/);
+    push @pkgs, $p if ($me eq $maint);
+  }
+  if ($maint eq "") {
+    @bugs = @{getbugs(sub {my %d=@_; my $me; 
+                      ($me = $maintainers{$d{"pkg"}}||"") =~ s/\s*\(.*\)\s*//;
+                      $me = $1 if ($me =~ m/<(.*)>/);
+                      return $me eq $maint;
+                    })};
+  } else {
+    @bugs = @{getbugs(sub {my %d=@_; my $me; 
+                      ($me = $maintainers{$d{"pkg"}}||"") =~ s/\s*\(.*\)\s*//;
+                      $me = $1 if ($me =~ m/<(.*)>/);
+                      return $me eq $maint;
+                    }, 'package', @pkgs)};
+  }
 } elsif (defined $maintenc) {
-    @bugs = maintencbugs($maintenc);
+  my %maintainers = %{getmaintainers()};
+  $tag = "encoded maintainer $maintenc";
+  @bugs = @{getbugs(sub {my %d=@_; 
+                      return maintencoded($maintainers{$d{"pkg"}} || "") 
+                        eq $maintenc
+                      })};
 } elsif (defined $submitter) {
-    @bugs = submitterbugs($submitter);
+  $tag = "submitter $submitter";
+  @bugs = @{getbugs(sub {my %d=@_; my $se; 
+                      ($se = $d{"submitter"} || "") =~ s/\s*\(.*\)\s*//;
+                      $se = $1 if ($se =~ m/<(.*)>/);
+                      return $se eq $submitter;
+                    }, 'submitter-email', $submitter)};
 } elsif (defined $severity) {
-    @bugs = severitybugs($status, $severity);
+  $tag = "$status $severity bugs";
+  @bugs = @{getbugs(sub {my %d=@_;
+                      return ($d{"severity"} eq $severity) 
+                        && ($d{"status"} eq $status);
+                    })};
 }
 
-my $result = htmlizebugs(@bugs);
+my $result = htmlizebugs(\@bugs);
 
 print "Content-Type: text/html\n\n";
 
-print "<HTML><HEAD><TITLE>\n" . 
-    "$debbugs::gProject $Archived $debbugs::gBug report logs: $tag\n" .
-    "</TITLE></HEAD>\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: $tag</TITLE>\n" .
+    "</HEAD>\n" .
     '<BODY TEXT="#000000" BGCOLOR="#FFFFFF" LINK="#0000FF" VLINK="#800080">' .
     "\n";
-print "<H1>" . "$debbugs::gProject $Archived $debbugs::gBug report logs: $tag" .
+print "<H1>" . "$debbugs::gProject$Archived $debbugs::gBug report logs: $tag" .
       "</H1>\n";
 
-if (defined $pkg) {
-    if (defined $maintainer{$pkg}) {
-        print "<p>Maintainer for $pkg is <a href=\"" 
-              . mainturl($maintainer{$pkg}) . "\">"
-              . htmlsanit($maintainer{$pkg}) . "</a>.</p>\n";
+if (defined $pkg || defined $src) {
+    my %maintainers = %{getmaintainers()};
+    my $maint = $pkg ? $maintainers{$pkg} : $maintainers{$src} ? $maintainers{$src} : undef;
+    if (defined $maint) {
+        print "<p>Maintainer for " . ( defined($pkg) ? $pkg : "source package $src" ) . " is <a href=\"" 
+              . mainturl($maint) . "\">"
+              . htmlsanit($maint) . "</a>.</p>\n";
+    }
+    my %pkgsrc = %{getpkgsrc()};
+    my @pkgs = getsrcpkgs($pkg ? $pkgsrc{ $pkg } : $src);
+    @pkgs = grep( !/^\Q$pkg\E$/, @pkgs ) if ( $pkg );
+    if ( @pkgs ) {
+       @pkgs = sort @pkgs;
+       if ($pkg) {
+               print "You may want to refer to the following packages that are part of the same source:<br>\n";
+       } else {
+               print "You may want to refer to the following individual bug pages:<br>\n";
+       }
+       push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) );
+       print join( ", ", map( "<A href=\"" . pkgurl($_) . "\">$_</A>", @pkgs ) );
+       print ".\n";
+    }
+    if ($pkg) {
+       my $stupidperl = ${debbugs::gPackagePages};
+       printf "<p>You might like to refer to the <a href=\"%s\">%s package page</a>", urlsanit("http://${debbugs::gPackagePages}/$pkg"), htmlsanit("$pkg");
+       if ($pkgsrc{ $pkg }) {
+           printf ", or to the source package <a href=\"%s\">%s</a>'s bug page.</p>\n", srcurl($pkg), htmlsanit($pkgsrc{$pkg});
+       } else {
+           printf ".\n";
+       }
     }
-    print "<p>Note that with multi-binary packages there may be other\n";
-    print "reports filed under the different binary package names.</p>\n";
-    print "\n";
-    printf "<p>You might like to refer to the <a href=\"%s\">%s package page</a></p>\n", "http://packages.debian.org/$pkg", "$pkg";
 } elsif (defined $maint || defined $maintenc) {
     print "<p>Note that maintainers may use different Maintainer fields for\n";
     print "different packages, so there may be other reports filed under\n";