Re: Machine readable interface
Hi,
I guess I was being a little too keen with simplifying the output. The
new attached versions implement your suggestions and so should be more
structured.
As for the log, I had included the full log rather than a parsed log
so that the client could parse it and display information about what the
bts had done in response to each message in any format it likes. I don't
think mbox format is sufficient as it does not show these details. The
standard output does give the information, but not in a machine readable
form. It also links to a webpage for the details of messages sent to
control, whereas the client might want that information available
directly. Additionally, giving the full log would allow the client to
process it differently if it wants; for example it might choose to show
all messages sent to control (except duplicates), or messages sent to
control with anything between the thanks/stop and the start of the sig.
(I've seen this done a few times. Perhaps there should be a warning in
the response email if such text exists and there were no other
recipients?)
Having said that, it would probably be useful to also have an option
to display a parsed log since many clients will not want to do the
parsing.
--
.''`. Mark Howard
: :' :
`. `' http://www.tildemh.com
`- mh@debian.org | mh@tildemh.com | mh344@cam.ac.uk
#!/usr/bin/perl -wT
package debbugs;
use strict;
require './common.pl';
require '/etc/debbugs/config';
use vars(qw($gSpoolDir));
my %param = readparse();
my $ref = $param{'bug'} || {
print "Content-Type: text/html\n\n",
"ERROR: must specify bug number";
exit 0;
}
$ref =~ /(\d+)/ or {
print "Content-Type: text/html\n\n",
"ERROR: invalid bug number";
exit 0;
}
$ref = $1;
my $buglog = buglog($ref);
my %status = %{getbugstatus($ref)};
unless (%status) {
print "Content-Type: text/html\n\n",
"ERROR: UNKNOWN BUG: $ref"
exit 0;
}
$|=1; # flush buffer after every print
my $archived = 0;
open L, "<$buglog" or &quitcgi("open log for $ref: $!");
if ($buglog !~ m#^\Q$gSpoolDir/db-h/#)
$archived = 1;
my @log = <L>;
close(L);
print <<END;
Content-Type: text/html
Output-Version: 1
Package: $status{package}
Severity: $status{severity}
Submitter: $status{originator}
Submission-Date: $status{date}
Merged-With: $status{mergedwith}
Tags: $status{tags}
Archived: $archived
@log
END
exit 0;
#!/usr/bin/perl -wT
package debbugs;
use strict;
use POSIX qw(strftime tzset nice);
require './common.pl';
require '/etc/debbugs/config';
require '/etc/debbugs/text';
nice(5);
my %param = readparse();
my $indexon = $param{'indexon'} || 'pkg';
if ($indexon !~ m/^(pkg|src|maint|submitter)$/) {
print "Content-Type: text/html\n\nERROR: You have to choose something to index on";
}
my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes";
my $archive = ($param{'archive'} || "no") eq "yes";
my $sortby = $param{'sortby'} || 'alpha';
if ($sortby !~ m/^(alpha|count)$/) {
print "Content-Type: text/html\n\nERROR: Don't know how to sort like that";
}
my $Archived = $archive ? " Archived" : "";
my %maintainers = %{&getmaintainers()};
my %strings = ();
set_option("repeatmerged", $repeatmerged);
set_option("archive", $archive);
my %count;
my %entry = ();
my %sortkey = ();
if ($indexon eq "pkg") {
%count = countbugs(sub {my %d=@_; return splitpackages($d{"pkg"})});
foreach my $pkg (keys %count) {
$sortkey{$pkg} = lc $pkg;
$entry{$pkg} = "Package: $pkg\n"
+ "Maintainer: " + ( $maintainers{$pkg} || "(unknown)" ) + "\n";
}
} elsif ($indexon eq "src") {
my $pkgsrc = getpkgsrc();
%count = countbugs(sub {my %d=@_;
return map {
$pkgsrc->{$_} || $_
} splitpackages($d{"pkg"});
});
foreach my $src (keys %count) {
$sortkey{$src} = lc $src;
$entry{$src} = "Source: $src\n"
+ "Maintainer: " + ( $maintainers{$pkg} || "(unknown)" ) + "\n";
}
} elsif ($indexon eq "maint") {
%count = countbugs(sub {my %d=@_;
return map {
emailfromrfc822($maintainers{$_}) || ()
} splitpackages($d{"pkg"});
});
my %email2maint = ();
for my $x (values %maintainers) {
my $y = emailfromrfc822($x);
$email2maint{$y} = $x unless (defined $email2maint{$y});
}
foreach my $maint (keys %count) {
$sortkey{$maint} = lc $email2maint{$maint} || "(unknown)";
$entry{$maint} = "Maintainer: " + ( $maintainers{$pkg} || "(unknown)" ) + "\n" ;
}
} elsif ($indexon eq "submitter") {
my %fullname = ();
%count = countbugs(sub {my %d=@_; my $f = $d{"submitter"} || "";
my $em = emailfromrfc822($f);
$fullname{$em} = $f if (!defined $fullname{$em});
return $em;
});
foreach my $sub (keys %count) {
$sortkey{$sub} = lc $fullname{$sub};
$entry{$sub} = "Submitter: $fullname{$sub}";
}
}
my @orderedentries;
if ($sortby eq "count") {
@orderedentries = sort { $count{$a} <=> $count{$b} } keys %count;
} else { # sortby alpha
@orderedentries = sort { $sortkey{$a} cmp $sortkey{$b} } keys %count;
}
print "Content-Type: text/html\n\n";
print "Output-Version: 1";
foreach my $x (@orderedentries) {
print $entry{$x};
print "Count: $count{$x}\n\n";
}
#!/usr/bin/perl -wT
package debbugs;
use strict;
use POSIX qw(strftime tzset nice);
require './common.pl';
require '/etc/debbugs/config';
if ($ENV{REQUEST_METHOD} eq 'HEAD') {
print "Content-Type: text/html\n\n";
exit 0;
}
nice(5);
my %param = readparse();
# what to return
my $show = ($param{'show'} || $param('show') ||'';
my @shows;
@shows = ( $show ) if (ref($show) eq "" && $show );
@shows = ( $$show ) if (ref($show) eq "SCALAR" && $$show );
@shows = @{$show} if (ref($show) eq "ARRAY" );
my ($lastmod, $date, $title, $package, $severity) = (0,0,0,0,0);
foreach (@shows){
if (m/lastmod/) {
$lastmod = 1;
}elsif (m/date/) {
$date = 1;
}elsif (m/title/) {
$title = 1;
}elsif (m/package/) {
$package = 1;
}elsif (m/severity/) {
$severity = 1;
}else{
print "Content-Type: text/html\n\nERROR: unknown show: "+$_;
}
}
my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes";
my $archive = ($param{'archive'} || "no") eq "yes";
my $include = $param{'&include'} || $param{'include'} || "";
my $exclude = $param{'&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 ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status, $tag);
my %which = (
'pkg' => \$pkg,
'src' => \$src,
'maint' => \$maint,
'maintenc' => \$maintenc,
'submitter' => \$submitter,
'severity' => \$severity,
'tag' => \$tag,
);
my @allowedEmpty = ( 'maint' );
my $found;
foreach ( keys %which ) {
$status = $param{'status'} || 'open' if /^severity$/;
if (($found = $param{$_})) {
${ $which{$_} } = $found;
last;
}
}
if (!$found && !$archive) {
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}));
}
}
}
print "Content-Type: text/html\n\nYou have to choose something to select by") if (!$found);
my $this = "";
my %indexentry;
my %strings = ();
set_option("repeatmerged", $repeatmerged);
set_option("archive", $archive);
set_option("include", $include);
set_option("exclude", $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 @bugs;
if (defined $pkg) {
@bugs = @{getbugs(sub {my %d=@_;
return grep($pkg eq $_, splitpackages($d{"pkg"}))
}, 'package', $pkg)};
} elsif (defined $src) {
my @pkgs = getsrcpkgs($src);
push @pkgs, $src if ( !grep(/^\Q$src\E$/, @pkgs) );
@bugs = @{getbugs(sub {my %d=@_;
foreach my $try (splitpackages($d{"pkg"})) {
return 1 if grep($try eq $_, @pkgs);
}
return 0;
}, 'package', @pkgs)};
} elsif (defined $maint) {
my %maintainers = %{getmaintainers()};
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;
foreach my $try (splitpackages($d{"pkg"})) {
($me = $maintainers{$try} || "")
=~ s/\s*\(.*\)\s*//;
$me = $1 if ($me =~ m/<(.*)>/);
return 1 if $me eq $maint;
}
return 0;
})};
} else {
@bugs = @{getbugs(sub {my %d=@_; my $me;
foreach my $try (splitpackages($d{"pkg"})) {
($me = $maintainers{$try} || "")
=~ s/\s*\(.*\)\s*//;
$me = $1 if ($me =~ m/<(.*)>/);
return 1 if $me eq $maint;
}
return 0;
}, 'package', @pkgs)};
}
} elsif (defined $maintenc) {
my %maintainers = %{getmaintainers()};
@bugs = @{getbugs(sub {my %d=@_;
foreach my $try (splitpackages($d{"pkg"})) {
return 1 if
maintencoded($maintainers{$try} || "") eq
$maintenc;
}
return 0;
})};
} elsif (defined $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) && defined($status)) {
@bugs = @{getbugs(sub {my %d=@_;
return ($d{"severity"} eq $severity)
&& ($d{"status"} eq $status);
})};
} elsif (defined($severity)) {
@bugs = @{getbugs(sub {my %d=@_;
return ($d{"severity"} eq $severity);
}, 'severity', $severity)};
} elsif (defined($tag)) {
@bugs = @{getbugs(sub {my %d = @_;
my %tags = map { $_ => 1 } split ' ', $d{"tags"};
return exists $tags{$tag};
})};
}
print "Content-Type: text/html\n\n";
## copied from common.pl
my @rawsort;
my %section = ();
if (@bugs == 0) {
exit(0);
# return "<HR><H2>No reports found!</H2></HR>\n";
}
if ( $common_bug_reverse ) {
@bugs = sort {$b<=>$a} @bugs;
} else {
@bugs = sort {$a<=>$b} @bugs;
}
my %seenmerged;
foreach my $bug (@bugs) {
my %status = %{getbugstatus($bug)};
next unless %status;
if (%common_include) {
my $okay = 0;
foreach my $t (split /\s+/, $status{tags}) {
$okay = 1, last if (defined $common_include{$t});
}
if (defined $common_include{subj}) {
if (index($status{subject}, $common_include{subj}) > -1) {
$okay = 1;
}
}
next unless ($okay);
}
if (%common_exclude) {
my $okay = 1;
foreach my $t (split /\s+/, $status{tags}) {
$okay = 0, last if (defined $common_exclude{$t});
}
if (defined $common_exclude{subj}) {
if (index($status{subject}, $common_exclude{subj}) > -1) {
$okay = 0;
}
}
next unless ($okay);
}
next if @common_pending_include and
not grep { $_ eq $status{pending} } @common_pending_include;
next if @common_severity_include and
not grep { $_ eq $status{severity} } @common_severity_include;
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;
# end: copied from common.pl
print "Bug: $bug\n";
print "Title: $status{subject}\n" if $title;
print "Date: $status{date}\n" if $date;
if ( $lastmod ){
my @stat = stat buglog($bug);
print "Last Modified: $stat[9]\n";
}
print "Package: $status{package}\n" if $package;
print "Severity: $status{severity}\n" if $severity;
print "\n";
}
Reply to: