tools/policy-bug-report

   1 #!/usr/bin/perl -w
   2 #
   3 # Retrieves the current list of Policy bugs awaiting review and produces a
   4 # formatted list suitable for mailing out, requesting review.
   5 #
   6 # Eventually, the goal is for this script to be expanded into one that can
   7 # give a summary for all open Policy bugs for a periodic automated report.
   8 #
   9 # The SOAP code here is based heavily on Devscripts::Debbugs.
  10
  11 use strict;
  12
  13 use SOAP::Lite ();
  14
  15 # The URL to the SOAP interface for the Debian BTS interface and the SOAP
  16 # namespace used by that interface.
  17 our $URL       = 'http://bugs.debian.org/cgi-bin/soap.cgi';
  18 our $NAMESPACE = 'Debbugs/SOAP/1';
  19
  20 # Abort if we get a SOAP error.  This function is used as the error handler
  21 # for our SOAP calls.
  22 sub die_soap {
  23     my ($soap, $result) = @_;
  24     my $error;
  25     if (ref $result) {
  26         $error = $result->faultstring;
  27     } else {
  28         $error = $soap->transport->status;
  29     }
  30     chomp $error;
  31     die "SOAP error: $error\n";
  32 }
  33
  34 # Initialize the SOAP::Lite object with the currect URL and namespace and
  35 # return it.
  36 sub init_soap {
  37     my $soap = SOAP::Lite->uri ($NAMESPACE)->proxy ($URL);
  38     $soap->transport->env_proxy;
  39     $soap->on_fault (\&die_soap);
  40 }
  41
  42 # Do a SOAP search for bugs following a particular provided criteria (as
  43 # key/value pairs) and print out a summary of all such bugs.  This currently
  44 # cannot handle usertags, only regular search criteria.
  45 sub print_bug_list {
  46     my ($soap, @criteria) = @_;
  47     unshift (@criteria, package => 'debian-policy');
  48     my $bugs = $soap->get_bugs (@criteria)->result;
  49     unless (@$bugs) {
  50         print "No bugs found\n";
  51     }
  52     my $info = $soap->get_status (@$bugs)->result;
  53     for my $bug (sort keys %$info) {
  54         my $desc = $info->{$bug}{subject};
  55         $desc =~ s/^debian-policy:\s+//;
  56         if (length ($desc) > 70) {
  57             $desc = substr ($desc, 0, 67) . '...';
  58         }
  59         print "#$bug $desc\n";
  60     }
  61 }
  62
  63 # Main routine.
  64 my $soap = init_soap;
  65 print "The following bugs have proposed wording awaiting further review:\n\n";
  66 print_bug_list ($soap, tag => 'patch');
  67 print "\nThe following bugs have been merged for the next release:\n\n";
  68 print_bug_list ($soap, tag => 'pending');
  69 print "\nThe following bugs have been rejected:\n\n";
  70 print_bug_list ($soap, tag => 'wontfix');