bin/bzreassign

   1 #! /usr/bin/perl
   2 # Click "Reassign bug to owner and QA contact of selected component"
   3 # for the Bug IDs given as arguments.
   4 # Configure: '$USERNAME' and '~/priv/bugzilla.pwd'.
   5 # Workarounds: 'nothing changed' of Bugzilla Version 2.18-rh.
   6 #
   7 # $Id$
   8
   9
  10 use strict;
  11 use warnings;
  12 require LWP::UserAgent;
  13 require URI::Escape;
  14 use Data::Dumper;
  15
  16 my $USERNAME='jkratoch%40redhat.com';
  17 my $PASSWORD=&_priv_get("bugzilla.pwd");
  18 my $BASE_GET='https://bugzilla.redhat.com/bugzilla/show_bug.cgi';
  19 my $BASE_POST='https://bugzilla.redhat.com/bugzilla/process_bug.cgi';
  20 $|=1;
  21 my $ua=LWP::UserAgent->new();
  22 #$ua->timeout(60);
  23 #$ua->env_proxy();      # conflicts with 'https'
  24 push @{$ua->requests_redirectable()},"POST";    # probably not needed
  25
  26 sub URL($$;@)
  27 {
  28 my($base,$id,@data)=@_;
  29
  30         return $base.'?'.join('&',
  31                         'GoAheadAndLogIn=1',
  32                         'Bugzilla_login='.$USERNAME,
  33                         'Bugzilla_password='.$PASSWORD,
  34                         'id='.$id,
  35                         @data);
  36 }
  37
  38 require HTTP::Cookies;
  39 my $jar=HTTP::Cookies->new();
  40 $ua->cookie_jar($jar);  # important
  41
  42 sub simple($;$)
  43 {
  44 my($url,$content)=@_;
  45
  46         my $request=HTTP::Request->new(($content ? "POST" : "GET"),$url);
  47         do { $request->content($_) if $_; } for $content;
  48         my $response=$ua->simple_request($request);
  49         die Dumper($response)."\n".$url if !$response->is_success() || !(my $r=$response->content());
  50         return $response;
  51 }
  52
  53 sub _priv_get($)
  54 {
  55 my($base)=@_;
  56
  57         my $full=$ENV{"HOME"}."/priv/".$base;
  58         local *F;
  59         open F,$full or die "$full: $!";
  60         my $r=do { local $/; <F>; } or die "read \"$full\": $!";
  61         close F or die "close \"$full\": $!";
  62         chomp $r;
  63         return $r;
  64 }
  65
  66 die "id list" if !@ARGV;
  67 for (@ARGV) {
  68         die $_ if !/^\d+$/;
  69 }
  70
  71 for my $id (@ARGV) {
  72         local *F;
  73         my $filename="/tmp/bzreassign-$id.log";
  74         print "$filename";
  75         open F,">$filename" or die "open $filename: $!";
  76         my $get=simple(URL($BASE_GET,$id));
  77         print F Dumper($get);
  78         $get=$get->{"_content"} or die;
  79         $get=~s{^.*(<form name="changeform".*</form>).*$}{$1}s or die;
  80         my %hidden;
  81         while ($get=~/<input\b([^>]*)>/ig) {
  82                 my $args=$1;
  83                 my %args;
  84                 $args{lc $1}=$2 while $args=~/\b(\w+)(?:="([^"]*)"|)/g;
  85                 my $type=$args{"type"}||"text";
  86                 $args{"value"}="" if $type eq "text" && !defined $args{"value"};
  87                 next if $type eq "submit" && !$args{"name"};
  88                 next if $type eq "checkbox" && !exists $args{"checked"};
  89                 if (!$args{"name"}) {
  90                         warn "no name: $args";
  91                         next;
  92                 }
  93                 if (!defined $args{"value"}) {
  94                         warn "no value: $args";
  95                         next;
  96                 }
  97                 next if $type eq "radio" && !exists $args{"checked"};
  98                 $hidden{$args{"name"}}=$args{"value"};
  99         }
 100         while ($get=~/<select\b([^>]*)>(.*?)<\/select>/igs) {
 101                 my $args=$1;
 102                 my $body=$2;
 103                 my $selected;
 104                 my $first;
 105                 while ($body=~/<option\b([^>]*)>/ig) {
 106                         my $args2=$1;
 107                         my %args2;
 108                         $args2{lc $1}=$2 while $args2=~/\b(\w+)(?:="([^"]*)"|)/g;
 109                         $first=$args2{"value"} if !defined $first;
 110                         if (exists $args2{"selected"}) {
 111                                 warn "already selected: $args" if defined $selected;
 112                                 $selected=$args2{"value"};
 113                                 last;
 114                         }
 115                 }
 116                 my %args;
 117                 $args{lc $1}=$2 while $args=~/\b(\w+)="([^"]*)"/g;
 118                 $selected=$first if !defined $selected && !exists $args{"multiple"};
 119                 next if !defined $selected && exists $args{"multiple"};
 120                 if (!$args{"name"}) {
 121                         warn "no name: $args";
 122                         next;
 123                 }
 124                 if (!defined $selected) {
 125                         warn "no selected: $args";
 126                         next;
 127                 }
 128                 $hidden{$args{"name"}}=$selected;
 129         }
 130         die "no keys" if !keys(%hidden);
 131         $hidden{"knobr"}="reassignbycomponent";;
 132         for my $key (keys(%hidden)) {
 133                 $_=$hidden{$key};
 134                 s/&#(\d+);/chr $1/eg;
 135                 s/&lt;/</g;
 136                 s/&gt;/>/g;
 137                 s/&quot;/"/g;
 138                 s/&amp;/&/g;
 139                 $_=URI::Escape::uri_escape($_);
 140                 $hidden{$key}=$_;
 141         }
 142         print F "$_=".$hidden{$_}."\n" for sort keys(%hidden);
 143         my $page=simple($BASE_POST,join('&',map($_."=".$hidden{$_},keys(%hidden))));
 144         print F Dumper($page);
 145         $page=$page->{"_content"} or die;
 146         $page=~/<title>Bug $id Processed/ or die;
 147         close F or die "$filename: $!";
 148         print "\n";
 149 }
 150 print "done\n";