Machine readable interface

To: debian-debbugs@lists.debian.org
Subject: Machine readable interface
From: Mark Howard <mh@tildemh.com>
Date: 26 Jun 2003 18:44:21 +0100
Message-id: <1056647122.29325.23.camel@pathfinderii.chu.cam.ac.uk>

Hi,
  I've been updating my bugwatcher program recently to the point where
it is now quite stable and useful. There are now only 2 major problems:
1. Getting it to work with an open source jvm
2. Poor performance interacting with the bts.

To help solve the second point, I would like to have a machine-friendly
interface to the bts. The attached cgi scripts hope to do this. 

I'm not a perl programmer, so I apologise for any stupid mistakes. I
don't have access to a debbug installation to test them on, so they are
untested.
Much of the code in machpkg.cgi is copied from common and pkgreport. If
you choose to use these scripts, it would probably be better to allow
this code to be shared. 

I would much appreciate it if you could review these scripts so that
hopefully they will at some point be good enough for the website.

thanks

[Please CC me - I'm not on the list]
-- 
  .''`. 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);

my $tagstr = '';
foreach my $tag (@gTags)
	$tagstr .= ($status{tags} =~ /$tag/) ? 1 : 0

print <<END;
Content-Type text/html

VERSION=1
$status{package}
$status{severity}
$status{originator}
$status{date}
$status{mergedwith}
$tagstr
$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';


if ($ENV{REQUEST_METHOD} eq 'HEAD') {
    print "Content-Type: text/html\n\n";
    exit 0;
}

nice(5);

my %param = readparse();

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'} || "";

# 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 ($date, $title, $package, $severity);
foreach (@shows){
	$date = 1 if m/date/;
	$title = 1 if m/title/;
	$package = 1 if m/package/;
	$severity = 1 if m/severity/;
}


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;
	print " \"$status{subject}\"" if $title;
	print " $status{date}" if $date;
	print " $status{package}" if $package;
	print " $status{severity}" if $severity;
	
}

Reply to:

Follow-Ups:
- Re: Machine readable interface
  - From: Colin Watson <cjwatson@debian.org>

Prev by Date: tags - information v requests for help
Next by Date: Re: Machine readable interface
Previous by thread: tags - information v requests for help
Next by thread: Re: Machine readable interface
Index(es):
- Date
- Thread