Commit 9950896d authored by Alex Muntada's avatar Alex Muntada

Remove scripts/forward-bug

Feature already available in scripts/forward.
parent 59d4dab4
......@@ -111,10 +111,6 @@ See L<dpt-debian-upstream(1)>.
See L<dpt-forward(1)>.
=item B<forward-bug> - forward a Debian bug to CPAN's request tracker
See L<dpt-forward-bug(1)>.
=item B<forward-patch> - forward a patch to CPAN's request tracker
See L<dpt-forward-patch(1)>.
......
#!/usr/bin/perl
use SOAP::Lite;
use RT::Client::REST;
use RT::Client::REST::Ticket;
use Proc::InvokeEditor;
use warnings;
use strict;
=head1 NAME
forward-bug - Forward Debian bug to CPAN's request tracker
=head1 SYNOPSIS
forward-bug BUGNUMBER [DISTRIBUTION]
Examples:
$ forward-bug 555555 Some-Dist # explicitly set dist name
$ forward-bug 32412314 # make f-b read dist name from debian/control
=head1 CONFIGURATION
B<forward-bug.pl> read the file C<~/.pause> for the configuration. The format is
the same that L<cpan-upload> requires:
user YOUR-PAUSE-ID
password YOUR-PAUSE-PASSWORD
If the distribution name is not set from the command-line B<forward-bug>
will also look at the C<Homepage> field in the C<debian/control> file or the
C<Source> filed in C<debian/copyright> and extracts the name from there.
=cut
my $bug = $ARGV[0];
my $dist = $ARGV[1];
die 'Err: Provide valid bug number' if !$bug;
if ( !$dist ) {
open my $dctrl, '<', 'debian/control'
or die "Err: Can't open debian/control for reading: $!";
while ( my $line = <$dctrl> ) {
if ( $line =~ /^Homepage/ ) {
if ( $line
=~ m{(?:http://search\.cpan\.org/dist|https://metacpan\.org/release)/(.*)/?}
)
{
$dist = $1;
}
}
}
close $dctrl or warn "Warn: Cannot close debian/control from reading: $!";
}
if ( !$dist ) {
open my $dcopyright, '<', 'debian/copyright'
or die "Err: Can't open debian/copyright for reading: $!";
while ( my $line = <$dcopyright> ) {
if ( $line =~ /^Source/ ) {
if ( $line
=~ m{(?:http://search\.cpan\.org/dist|https://metacpan\.org/release)/(.*)/?}
)
{
$dist = $1;
}
}
}
close $dcopyright
or warn "Cannot close debian/copyright from reading: $!";
}
die 'Err: Provide valid distribution name' if !$dist;
# retrieve bug info
my $soap = SOAP::Lite->uri('Debbugs/SOAP')
->proxy('http://bugs.debian.org/cgi-bin/soap.cgi');
my $info = $soap->get_status($bug)->result()->{$bug};
if ( $info->{'done'} ) {
die 'Err: Bug already closed';
}
if ( $info->{'forwarded'} ) {
die 'Err: Bug already forwarded at ' . $info->{'forwarded'};
}
# (cf. http://wiki.debian.org/DebbugsSoapInterface)
# try to get the body of the first message
# get_bug_log() fails with a SOAP error for some bugs. cf. #635018
my $log;
eval { $log = $soap->get_bug_log($bug)->result(); };
if ($@) {
$log = undef;
}
else {
$log = $log->[0]->{body};
}
# RT config
my $rtserver = 'https://rt.cpan.org';
my %rtlogin;
open my $pauserc, '<', $ENV{'HOME'} . '/.pause'
or die "Err: Can't open ~/.pause for reading: $!";
while (<$pauserc>) {
chomp;
next unless $_ and $_ !~ /^\s*#/;
my ( $k, $v ) = /^\s*(\w+)\s+(.+)$/;
$rtlogin{$k} = $v;
}
close $pauserc or warn "Cannot close ~/.pause from reading: $!";
die 'Err: Provide valid PAUSE credentials'
if not $rtlogin{'user'}
or not $rtlogin{'password'};
my $name = $ENV{'DEBFULLNAME'};
my $email
= $ENV{'DEBEMAIL'}
|| $ENV{'EMAIL'}
|| die "Err: Set a valid email address";
if ( !$name ) {
$name = ( getpwuid($<) )[6];
$name =~ s/,.*//;
}
my $body = "This bug has been forwarded from http://bugs.debian.org/$bug\n";
$body .= "\n" . '-->' x 20 . "\n";
$body .= "\n$log\n" if $log;
$body .= "\n" . '<--' x 20 . "\n";
$body .= "\nThanks in advance,\n";
$body .= "$name, Debian Perl Group\n";
# generate body for ticket
my $text = Proc::InvokeEditor->edit($body);
# RT REST
my $rt = RT::Client::REST->new( server => $rtserver );
# login to RT
$rt->login( username => $rtlogin{'user'}, password => $rtlogin{'password'} );
# create new RT ticket
my $ticket = RT::Client::REST::Ticket->new(
rt => $rt,
queue => $dist,
subject => $info->{'subject'},
requestor => [$email],
)->store( text => $text );
# set Debian bug as 'forwarded'
my $url = 'http://rt.cpan.org/Public/Bug/Display.html?id=' . $ticket->id;
system( '/usr/bin/bts', 'forwarded', $info->{'bug_num'}, $url );
=head1 AUTHOR
Alessandro Ghedini <ghedo@debian.org>
=head1 LICENSE AND COPYRIGHT
Copyright 2011 Alessandro Ghedini.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment