#!/usr/bin/perl

use MIME::Lite;
use File::Basename;
use Term::ReadLine;
use Proc::InvokeEditor;

use warnings;
use strict;

=head1 NAME

forward-patch - Forward a patch to CPAN's request tracker

=head1 SYNOPSIS

 forward-patch PATCH [DISTRIBUTION]

 Examples:
   $ forward-patch some-patch.patch Some-Dist # explicitly set dist name
   $ forward-patch 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.

B<forward-patch> will use by default the C<DEBFULLNAME> and C<DEBEMAIL>
environment variables to retrieve information about the ticket author. If not set,
L<getpwuid> and the C<EMAIL> environment variable will be used.

=cut

my $patch = $ARGV[0];
my $dist  = $ARGV[1];

die 'Err: Provide a valid patch file' if !$patch;

if ( !$dist ) {
    open my $dctrl, '<', 'debian/control'
        or die "Err: Can't open debain/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 "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;

# prepare subject
my $term = Term::ReadLine->new('forward-patch');
my $subject = $term->readline( 'Subject>', '[PATCH] ' );
if ( $subject eq '[PATCH] ' ) {
    $subject .= basename($patch);
    $subject =~ s/(\_|\-)/\ /g;
    $subject =~ s/(\.patch|\.diff)//;
}

# 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/,.*//;
}

# prepare body
my $body
    = "In Debian we are currently applying the attached patch to $dist.\n";
$body .= "We thought you might be interested in it, too.\n\n";

open my $patch_fh, '<', $patch
    or die "Err: Can't open $patch for reading: $!";

while ( my $line = <$patch_fh> ) {
    last if ( $line =~ /^--- / );
    next if ( $line =~ /^Forwarded:/ );
    $body .= $line;
}

close $patch_fh or warn "Cannot close $patch from reading: $!";

$body .= "\nThanks in advance,\n";
$body .= "$name, Debian Perl Group\n";

# now on to the email
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";

# edit body for ticket
my $text = Proc::InvokeEditor->edit($body);

$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;

# TODO
# find bug on https://rt.cpan.org/Public/Dist/Display.html?Name=$dist
# or via RT::Client::REST and add the URL to the Forwarded header in the patch

my $rturl = "https://rt.cpan.org/Public/Dist/Display.html?Name=$dist";
print "Find your ticket on\n"
    . "$rturl\n"
    . "and add the ticket URL to $patch\n\n"
    . "Trying to open the URL with sensible-browser now.\n";
system( 'sensible-browser', "$rturl" );

=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