r70990 - /scripts/forward-bug

ghedo-guest at users.alioth.debian.org ghedo-guest at users.alioth.debian.org
Wed Mar 9 19:28:23 UTC 2011


Author: ghedo-guest
Date: Wed Mar  9 19:27:53 2011
New Revision: 70990

URL: http://svn.debian.org/wsvn/?sc=1&rev=70990
Log:
import the forward-bug script

Added:
    scripts/forward-bug   (with props)

Added: scripts/forward-bug
URL: http://svn.debian.org/wsvn/scripts/forward-bug?rev=70990&op=file
==============================================================================
--- scripts/forward-bug (added)
+++ scripts/forward-bug Wed Mar  9 19:27:53 2011
@@ -1,0 +1,136 @@
+#!/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 debain/control for reading: $!";
+
+	while (<$dctrl>) {
+		if (/^Homepage/) {
+			/http:\/\/search.cpan.org\/dist\/(.*)\//;
+			$dist = $1;
+		}
+	}
+}
+
+if (!$dist) {
+	open my $dcopyright, '<', 'debian/copyright'
+		or die "Err: Can't open debain/copyright for reading: $!";
+
+	while (<$dcopyright>) {
+		if (/^Source/) {
+			/http:\/\/search.cpan.org\/dist\/(.*)\//;
+			$dist = $1;
+		}
+	}
+}
+
+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'};
+}
+
+# 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;
+}
+
+die 'Err: Provide valid PAUSE credentials' if !$rtlogin{'user'} or !$rtlogin{'password'};
+
+# generate body for ticket
+my $text = Proc::InvokeEditor -> edit(
+	"This bug has been forwarded from http:://bugs.debian.org/$bug"
+);
+
+# 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'},
+) -> 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 <alexbio at cpan.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

Propchange: scripts/forward-bug
------------------------------------------------------------------------------
    svn:executable = *




More information about the Pkg-perl-cvs-commits mailing list