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 # Originally written by Russ Allbery.  Enhanced to handle usertags by
  12 # Sean Whitton.
  13
  14 use strict;
  15
  16 use SOAP::Lite ();
  17 use List::MoreUtils qw(first_index);
  18 use Array::Utils qw(intersect);
  19
  20 # The URL to the SOAP interface for the Debian BTS interface and the SOAP
  21 # namespace used by that interface.
  22 our $URL       = 'https://bugs.debian.org/cgi-bin/soap.cgi';
  23 our $NAMESPACE = 'Debbugs/SOAP/1';
  24
  25 # Abort if we get a SOAP error.  This function is used as the error handler
  26 # for our SOAP calls.
  27 sub die_soap {
  28     my ($soap, $result) = @_;
  29     my $error;
  30     if (ref $result) {
  31         $error = $result->faultstring;
  32     } else {
  33         $error = $soap->transport->status;
  34     }
  35     chomp $error;
  36     die "SOAP error: $error\n";
  37 }
  38
  39 # Initialize the SOAP::Lite object with the currect URL and namespace and
  40 # return it.
  41 sub init_soap {
  42     my $soap = SOAP::Lite->uri ($NAMESPACE)->proxy ($URL);
  43     $soap->transport->env_proxy;
  44     $soap->on_fault (\&die_soap);
  45 }
  46
  47 # Do a SOAP search for bugs following a particular provided criteria
  48 # (as key/value pairs) and print out a summary of all such bugs.
  49 # Criteria are conjoined, but there is known bug with this when more
  50 # than one 'usertag' criteria is specified
  51 sub print_bug_list {
  52     my ($soap, @criteria) = @_;
  53     unshift (@criteria, status => 'open');
  54     unshift (@criteria, package => 'debian-policy');
  55     # the soap interface separates fetching bugs by usertag and
  56     # fetching bugs by all other criteria, so we have to filter out
  57     # 'usertag' and handle it differently
  58     my @usertags;
  59     while (my $usertag_index = first_index { $_ eq 'usertag' } @criteria) {
  60         last if $usertag_index < 0;
  61         push @usertags, $criteria[$usertag_index + 1];
  62         # now we have the usertag, drop it from the criteria fed to the
  63         # non-usertag SOAP interface
  64         splice @criteria, $usertag_index, 2;
  65     }
  66     my $bugs;
  67     if (@usertags) {
  68         my @usertag_bugs;
  69         my $usertag_bugs_hash = $soap->
  70           get_usertag ('debian-policy@packages.debian.org', @usertags)->result;
  71         foreach my $key (keys %$usertag_bugs_hash) {
  72             my @value = @{$usertag_bugs_hash->{$key}};
  73             if (scalar @usertag_bugs < 1) {
  74                 @usertag_bugs = @value;
  75             } else {
  76                 @usertag_bugs = intersect (@usertag_bugs, @value);
  77             }
  78         }
  79         my $all_bugs = $soap->get_bugs (@criteria)->result;
  80         my @bugs = intersect (@usertag_bugs, @$all_bugs);
  81         $bugs = \@bugs;
  82     } else {
  83         $bugs = $soap->get_bugs (@criteria)->result;
  84     }
  85     unless (@$bugs) {
  86         print "No bugs found\n";
  87         return;
  88     }
  89     my $info = $soap->get_status (@$bugs)->result;
  90     for my $bug (sort keys %$info) {
  91         my $desc = $info->{$bug}{subject};
  92         $desc =~ s/^debian-policy:\s+//;
  93         if (length ($desc) > 70) {
  94             $desc = substr ($desc, 0, 67) . '...';
  95         }
  96         print "#$bug $desc\n";
  97     }
  98 }
  99
 100 # Main routine.
 101 my $soap = init_soap;
 102 print "Consensus has been reached and help is needed to write a patch:\n\n";
 103 print_bug_list ($soap, usertag => 'proposal');
 104 print "\nWording proposed, awaiting review from anyone and/or seconds by DDs:\n\n";
 105 print_bug_list ($soap, tag => 'patch');
 106 print "\nMerged for the next release:\n\n";
 107 print_bug_list ($soap, tag => 'pending');