runner/adt-openbugs-fetch-debbugs

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use Data::Dumper;
   6 use SOAP::Lite;
   7
   8 die if @ARGV;
   9
  10 sub e ($) {
  11     my ($v) = @_;
  12     $v= ''.$v;
  13     my $r= $ENV{$v};
  14     die "need $v in environment" unless defined $r;
  15     return $r;
  16 }
  17
  18 my $dist= e('distro');
  19 my $debbugs_soap= e('openbugs_debbugs_soap');
  20 my $debbugs_uri= e('openbugs_debbugs_uri');
  21 my $usertag_owner= e('openbugs_usertag_owner');
  22 my $usertag_name= e('openbugs_usertag_name');
  23
  24 my $soap= SOAP::Lite->uri($debbugs_soap)->proxy($debbugs_uri);
  25
  26 open D, "> /dev/null" or die $!;
  27
  28 my $bugs_ut= $soap->get_usertag($usertag_owner, $usertag_name)->result();
  29 printf D "bugs_ut: %s\n", Dumper($bugs_ut);
  30
  31 my $bugs_rq= [map { [bug => $_, dist => $dist] } @{$bugs_ut->{$usertag_name}}];
  32 printf D "bugs_rq: %s\n", Dumper($bugs_rq);
  33
  34 my $stats= $soap->get_status($bugs_rq)->result();
  35 printf D "bugs_rq: %s\nstats: %s\n", Dumper($bugs_rq), Dumper($stats);
  36
  37 my $stat;
  38
  39 sub badbug ($) {
  40     my ($msg) = @_;
  41     die "BAD BUG - $msg:\n".Dumper($stat)."\n - $msg !";
  42 }
  43
  44 foreach $stat (values %$stats) {
  45     printf D "==========\n%s\n", Dumper($stat);
  46     next if $stat->{'pending'} eq 'done';
  47     my $fv= $stat->{'found_versions'};
  48     @$fv or badbug("pending but not found");
  49     $fv= $fv->[$#$fv];
  50     my $src= $fv =~ m,/, ? $` : $stat->{'package'};
  51     $src !~ m/[^-+.0-9a-z]/ and $src =~ m/^[0-9a-z]/ or badbug('bad package');
  52     my $id= $stat->{'id'};
  53     $id !~ m/\D/ and $id =~ m/^[1-9]/ or badbug("bad id");
  54     printf "%s %d\n", $src, $id
  55         or die $!;
  56 }
  57
  58 STDOUT->error and die $!;
  59 close STDOUT or die $!;