policy-bug-report 2.2 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071
  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. use strict;
  11. use SOAP::Lite ();
  12. # The URL to the SOAP interface for the Debian BTS interface and the SOAP
  13. # namespace used by that interface.
  14. our $URL = 'http://bugs.debian.org/cgi-bin/soap.cgi';
  15. our $NAMESPACE = 'Debbugs/SOAP/1';
  16. # Abort if we get a SOAP error. This function is used as the error handler
  17. # for our SOAP calls.
  18. sub die_soap {
  19. my ($soap, $result) = @_;
  20. my $error;
  21. if (ref $result) {
  22. $error = $result->faultstring;
  23. } else {
  24. $error = $soap->transport->status;
  25. }
  26. chomp $error;
  27. die "SOAP error: $error\n";
  28. }
  29. # Initialize the SOAP::Lite object with the currect URL and namespace and
  30. # return it.
  31. sub init_soap {
  32. my $soap = SOAP::Lite->uri ($NAMESPACE)->proxy ($URL);
  33. $soap->transport->env_proxy;
  34. $soap->on_fault (\&die_soap);
  35. }
  36. # Do a SOAP search for bugs following a particular provided criteria (as
  37. # key/value pairs) and print out a summary of all such bugs. This currently
  38. # cannot handle usertags, only regular search criteria.
  39. sub print_bug_list {
  40. my ($soap, @criteria) = @_;
  41. unshift (@criteria, package => 'debian-policy');
  42. my $bugs = $soap->get_bugs (@criteria)->result;
  43. unless (@$bugs) {
  44. print "No bugs found\n";
  45. }
  46. my $info = $soap->get_status (@$bugs)->result;
  47. for my $bug (sort keys %$info) {
  48. my $desc = $info->{$bug}{subject};
  49. $desc =~ s/^debian-policy:\s+//;
  50. if (length ($desc) > 70) {
  51. $desc = substr ($desc, 0, 67) . '...';
  52. }
  53. print "#$bug $desc\n";
  54. }
  55. }
  56. # Main routine.
  57. my $soap = init_soap;
  58. print "The following bugs have proposed wording awaiting further review:\n\n";
  59. print_bug_list ($soap, tag => 'patch');
  60. print "\nThe following bugs have been merged for the next release:\n\n";
  61. print_bug_list ($soap, tag => 'pending');
  62. print "\nThe following bugs have been rejected:\n\n";
  63. print_bug_list ($soap, tag => 'wontfix');