#! /usr/bin/perl
# Click "Reassign bug to owner and QA contact of selected component"
# for the Bug IDs given as arguments.
# Configure: '$USERNAME' and '~/priv/bugzilla.pwd'.
# Workarounds: 'nothing changed' of Bugzilla Version 2.18-rh.
#
# $Id$


use strict;
use warnings;
require LWP::UserAgent;
require URI::Escape;
use Data::Dumper;

my $USERNAME='jkratoch%40redhat.com';
my $PASSWORD=&_priv_get("bugzilla.pwd");
my $BASE_GET='https://bugzilla.redhat.com/bugzilla/show_bug.cgi';
my $BASE_POST='https://bugzilla.redhat.com/bugzilla/process_bug.cgi';
$|=1;
my $ua=LWP::UserAgent->new();
#$ua->timeout(60);
#$ua->env_proxy();	# conflicts with 'https'
push @{$ua->requests_redirectable()},"POST";	# probably not needed

sub URL($$;@)
{
my($base,$id,@data)=@_;

	return $base.'?'.join('&',
			'GoAheadAndLogIn=1',
			'Bugzilla_login='.$USERNAME,
			'Bugzilla_password='.$PASSWORD,
			'id='.$id,
			@data);
}

require HTTP::Cookies;
my $jar=HTTP::Cookies->new();
$ua->cookie_jar($jar);	# important

sub simple($;$)
{
my($url,$content)=@_;

	my $request=HTTP::Request->new(($content ? "POST" : "GET"),$url);
	do { $request->content($_) if $_; } for $content;
	my $response=$ua->simple_request($request);
	die Dumper($response)."\n".$url if !$response->is_success() || !(my $r=$response->content());
	return $response;
}

sub _priv_get($)
{
my($base)=@_;

	my $full=$ENV{"HOME"}."/priv/".$base;
	local *F;
	open F,$full or die "$full: $!";
	my $r=do { local $/; <F>; } or die "read \"$full\": $!";
	close F or die "close \"$full\": $!";
	chomp $r;
	return $r;
}

die "id list" if !@ARGV;
for (@ARGV) {
	die $_ if !/^\d+$/;
}

for my $id (@ARGV) {
	local *F;
	my $filename="/tmp/bzreassign-$id.log";
	print "$filename";
	open F,">$filename" or die "open $filename: $!";
	my $get=simple(URL($BASE_GET,$id));
	print F Dumper($get);
	$get=$get->{"_content"} or die;
	$get=~s{^.*(<form name="changeform".*</form>).*$}{$1}s or die;
	my %hidden;
	while ($get=~/<input\b([^>]*)>/ig) {
		my $args=$1;
		my %args;
		$args{lc $1}=$2 while $args=~/\b(\w+)(?:="([^"]*)"|)/g;
		my $type=$args{"type"}||"text";
		$args{"value"}="" if $type eq "text" && !defined $args{"value"};
		next if $type eq "submit" && !$args{"name"};
		next if $type eq "checkbox" && !exists $args{"checked"};
		if (!$args{"name"}) {
			warn "no name: $args";
			next;
		}
		if (!defined $args{"value"}) {
			warn "no value: $args";
			next;
		}
		next if $type eq "radio" && !exists $args{"checked"};
		$hidden{$args{"name"}}=$args{"value"};
	}
	while ($get=~/<select\b([^>]*)>(.*?)<\/select>/igs) {
		my $args=$1;
		my $body=$2;
		my $selected;
		my $first;
		while ($body=~/<option\b([^>]*)>/ig) {
			my $args2=$1;
			my %args2;
			$args2{lc $1}=$2 while $args2=~/\b(\w+)(?:="([^"]*)"|)/g;
			$first=$args2{"value"} if !defined $first;
			if (exists $args2{"selected"}) {
				warn "already selected: $args" if defined $selected;
				$selected=$args2{"value"};
				last;
			}
		}
		my %args;
		$args{lc $1}=$2 while $args=~/\b(\w+)="([^"]*)"/g;
		$selected=$first if !defined $selected && !exists $args{"multiple"};
		next if !defined $selected && exists $args{"multiple"};
		if (!$args{"name"}) {
			warn "no name: $args";
			next;
		}
		if (!defined $selected) {
			warn "no selected: $args";
			next;
		}
		$hidden{$args{"name"}}=$selected;
	}
	die "no keys" if !keys(%hidden);
	$hidden{"knobr"}="reassignbycomponent";;
	for my $key (keys(%hidden)) {
		$_=$hidden{$key};
		s/&#(\d+);/chr $1/eg;
		s/&lt;/</g;
		s/&gt;/>/g;
		s/&quot;/"/g;
		s/&amp;/&/g;
		$_=URI::Escape::uri_escape($_);
		$hidden{$key}=$_;
	}
	print F "$_=".$hidden{$_}."\n" for sort keys(%hidden);
	my $page=simple($BASE_POST,join('&',map($_."=".$hidden{$_},keys(%hidden))));
	print F Dumper($page);
	$page=$page->{"_content"} or die;
	$page=~/<title>Bug $id Processed/ or die;
	close F or die "$filename: $!";
	print "\n";
}
print "done\n";