r71868 - in /scripts: forward-patch forward-patch.orig

[ghedo-guest at users.alioth.debian.org]

Author: ghedo-guest
Date: Tue Mar 22 20:27:25 2011
New Revision: 71868

URL: http://svn.debian.org/wsvn/?sc=1&rev=71868
Log:
import first (dirty) version of forward-patch

Added:
    scripts/forward-patch   (with props)
    scripts/forward-patch.orig
      - copied unchanged from r70989, scripts/forward-patch

Added: scripts/forward-patch
URL: http://svn.debian.org/wsvn/scripts/forward-patch?rev=71868&op=file
==============================================================================
--- scripts/forward-patch (added)
+++ scripts/forward-patch Tue Mar 22 20:27:25 2011
@@ -1,0 +1,132 @@
+#!/usr/bin/perl
+
+use MIME::Lite;
+use File::Basename;
+use Proc::InvokeEditor;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+forward-patch - Forward a patch to CPAN's request tracker
+
+=head1 SYNOPSIS
+
+ forward-bug PATCH [DISTRIBUTION]
+
+ Examples:
+   $ forward-patch some-patch.patch Some-Dist # explicitly set dist name
+   $ forward-bug some-patch.patch             # make f-p read dist name from debian/control
+
+=head1 CONFIGURATION
+
+If the distribution name is not set from the command-line B<forward-patch>
+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 $patch = $ARGV[0];
+my $dist = $ARGV[1];
+
+die 'Err: Provide a valid patch file' if !$patch;
+
+my $subject = basename($patch);
+$subject =~ s/(\_|\-)/\ /g;
+$subject =~ s/(\.patch|\.diff)//;
+
+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;
+
+# read patch header
+open my $patch_fh, '<', $patch
+	or die "Err: Can't open $patch for reading: $!";
+
+my $header = "";
+
+while (my $line = <$patch_fh>) {
+	last if ($line =~ /^--- /);
+	$header .= $line;
+}
+
+# RT::Client::REST does not support attachments, we need to use the email interface
+
+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 $from = "$name <$email>";
+my $to = 'bug-'.lc($dist).'@rt.cpan.org';
+
+my $msg = MIME::Lite -> new(
+	From => $from,
+	To => $to,
+	Subject => $subject,
+	Type =>'multipart/mixed'
+) or die "Error creating multipart container: $!\n";
+
+# generate body for ticket
+my $text = Proc::InvokeEditor -> edit(
+	$header
+);
+
+$msg -> attach (
+	Type => 'TEXT',
+	Data => $text
+) or die "Error adding the text message part: $!\n";
+
+# add the patch as attachment
+$msg -> attach (
+	Type => 'TEXT',
+	Path => $patch,
+	Filename => basename($patch),
+	Disposition => 'attachment'
+) or die "Error adding attachment: $!\n";
+
+# the email is not currently sent
+MIME::Lite -> send('sendmail', '/usr/sbin/sendmail -t'); # change mailer to your needs
+$msg -> send;
+
+=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-patch
------------------------------------------------------------------------------
    svn:executable = *