[pkg-perl-tools] 01/01: Remove scripts/forward-patch
Alex Muntada
alexm-guest at moszumanska.debian.org
Sat May 21 14:00:05 UTC 2016
This is an automated email from the git hooks/post-receive script.
alexm-guest pushed a commit to branch master
in repository pkg-perl-tools.
commit 82c8f3d42bbad354eac680080f91164e85419b1d
Author: Alex Muntada <alexm at alexm.org>
Date: Sat May 21 15:57:48 2016 +0200
Remove scripts/forward-patch
---
TODO | 2 -
bin/dpt | 4 -
scripts/forward | 93 +++++++++++-
scripts/forward-patch | 391 --------------------------------------------------
4 files changed, 86 insertions(+), 404 deletions(-)
diff --git a/TODO b/TODO
index 66cca96..a3fd412 100644
--- a/TODO
+++ b/TODO
@@ -15,8 +15,6 @@ TODOS:
should not go into in the package.
- lintian check: ensure that arch-dep packages use M-A:same
- lintian check: check for unversioned 'perl' in Depends
-- forward: adopt the mail bug reporting interface from forward-patch/-bug
- and then drop -patch/-bug
- forward: when forwarding patches to github, pull request would be nicer
than an issue with a link to the patch
- forward: read from d/u/metadata as well
diff --git a/bin/dpt b/bin/dpt
index aac8339..ba7b1f9 100755
--- a/bin/dpt
+++ b/bin/dpt
@@ -111,10 +111,6 @@ See L<dpt-debian-upstream(1)>.
See L<dpt-forward(1)>.
-=item B<forward-patch> - forward a patch to CPAN's request tracker
-
-See L<dpt-forward-patch(1)>.
-
=item B<gc> - swipe pkg-perl working directories
See L<dpt-gc(1)>.
diff --git a/scripts/forward b/scripts/forward
index 35dc7d3..39bf7c2 100755
--- a/scripts/forward
+++ b/scripts/forward
@@ -14,6 +14,7 @@ use Term::ReadLine;
use Time::Piece qw(localtime);
use Text::Wrap qw(wrap);
use Proc::InvokeEditor;
+use MIME::Lite;
use warnings;
use strict;
@@ -93,6 +94,16 @@ resources->bugtracker->web >> field of F<META>. Defaults to C<<
https://rt.cpan.org/Public/Dist/Display.html?Name=I<dist-name> >> for B<cpan> and
is mandatory for B<github>.
+=item B<--use-mail>
+
+Send bug and patch submissions by e-mail instead.
+
+=item B<--mailto> I<address>
+
+This option sets the e-mail address to forward to. The default
+is determined from the C<< resources->bugtracker->mailto >>
+field of F<META> or CPAN RT bug address if that field is not present.
+
=back
=cut
@@ -107,6 +118,8 @@ my $opt_mode;
my $opt_offline_test;
my $opt_meta_file;
my $opt_ticket;
+my $opt_use_mail;
+my $opt_mailto;
GetOptions(
'd|dist=s' => \$opt_dist,
@@ -117,6 +130,8 @@ GetOptions(
'offline-test!' => \$opt_offline_test,
'meta=s' => \$opt_meta_file,
'ticket=s' => \$opt_ticket,
+ 'use-mail!' => \$opt_use_mail,
+ 'mailto=s' => \$opt_mailto,
) or exit 1;
die
@@ -138,13 +153,13 @@ die "Unable to determine distribution name.\n"
. "Please use the --dist option.\n"
unless $opt_dist;
-$opt_tracker_url ||= $meta->resources->{bugtracker}{web}
- if $meta
- and $meta->resources
- and $meta->resources->{bugtracker};
+if ( $meta and $meta->resources and $meta->resources->{bugtracker} ) {
+ $opt_tracker_url ||= $meta->resources->{bugtracker}{web};
+ $opt_mailto ||= $meta->resources->{bugtracker}{mailto};
+}
unless ($opt_tracker_url) {
- warn "Bug tracker not found in META.\n";
+ warn "Bug tracker web not found in META.\n";
$opt_tracker_url
= "https://rt.cpan.org/Public/Dist/Display.html?Name=$opt_dist";
@@ -152,6 +167,14 @@ unless ($opt_tracker_url) {
warn "Falling back to $opt_tracker_url\n";
}
+unless ($opt_mailto) {
+ warn "Bug tracker mail not found in META.\n";
+
+ $opt_mailto = 'bug-' . lc($opt_dist) . '@rt.cpan.org';
+
+ warn "Falling back to $opt_mailto\n";
+}
+
$opt_tracker ||= detect_tracker();
$opt_mode ||= 'patch'
@@ -210,10 +233,12 @@ if ($patch) {
}
unless ( $patch_info{Subject} ) {
+ # TODO: Use basename($patch) instead?
# default subject is the patch name
my $fn = ( File::Spec->splitpath($patch) )[-1];
$fn =~ s/\.(?:patch|diff)$//; # strip extension
$fn =~ s/^\d+[-_]?//; # strip leading number
+ $fn =~ s/(\_|\-)/ /g; # spaces make reading easier
$patch_info{Subject} = $fn;
}
}
@@ -273,7 +298,7 @@ sub get_subject {
my $term = Term::ReadLine->new('forward');
- return $term->readline( 'Subject:', $default );
+ return $term->readline( 'Subject: ', $default );
}
sub detect_dist {
@@ -419,6 +444,49 @@ sub prepare_body {
return edit_message($body);
}
+sub send_by_mail {
+ my $from = "$name <$email>";
+ my $text = prepare_body();
+ my $subject = get_subject();
+
+ my $msg = MIME::Lite->new(
+ From => $from,
+ To => $opt_mailto,
+ Subject => $subject,
+ Type => 'multipart/mixed'
+ ) or die "Error creating multipart container: $!\n";
+
+ $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;
+
+ if (!$opt_mailto) {
+ # TODO
+ # find bug on https://rt.cpan.org/Public/Dist/Display.html?Name=$opt_dist
+ # or via RT::Client::REST and add the URL to the Forwarded header in the patch
+
+ print "Find your ticket on\n"
+ . "$opt_tracker_url\n"
+ . "and add the ticket URL to $patch\n\n"
+ . "Trying to open the URL with sensible-browser now.\n";
+ system( 'sensible-browser', $opt_tracker_url );
+ }
+}
+
sub submit_cpan_rt {
# prepare subject
my $subject = get_subject();
@@ -660,7 +728,10 @@ sub detect_tracker {
die "Unable to determine bug tracker from URL '$opt_tracker_url'.\n";
}
-if ( $opt_tracker eq 'cpan' ) {
+if ($opt_use_mail) {
+ send_by_mail();
+}
+elsif ( $opt_tracker eq 'cpan' ) {
submit_cpan_rt();
}
elsif ( $opt_tracker eq 'github' ) {
@@ -676,14 +747,22 @@ else {
=item Alessandro Ghedini <ghedo at debian.org>.
+=item Alex Muntada <alexm at alexm.org>.
+
=item Damyan Ivanov <dmn at debian.org>.
+=item Salvatore Bonaccorso <carnil at debian.org>.
+
=back
=head1 LICENSE AND COPYRIGHT
=over
+=item Copyright 2016 Alex Muntada.
+
+=item Copyright 2014 Salvatore Bonaccorso.
+
=item Copyright 2014 Damyan Ivanov.
=item Copyright 2011 Alessandro Ghedini.
diff --git a/scripts/forward-patch b/scripts/forward-patch
deleted file mode 100755
index 6b053f4..0000000
--- a/scripts/forward-patch
+++ /dev/null
@@ -1,391 +0,0 @@
-#!/usr/bin/perl
-
-use CPAN::Meta;
-use Cwd qw(getcwd);
-use MIME::Lite;
-use File::Basename;
-use File::Slurp qw(read_file write_file);
-use Getopt::Long;
-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 [option...] 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.
-
-=head1 OPTIONS
-
-=over
-
-=item B<--tracker> I<tracker-name>
-
-Instructs B<forward-patch> to use the specified issue tracker.
-
-Supported values for I<tracker-name> are:
-
-=over
-
-=item B<github>
-
-Uses GitHub API to submit the patch as an issue. Requires proper
-C<< resources->repository >> in F<META>.
-
-=item B<cpan>
-
-Submits the patch to L<http://rt.cpan.org>.
-
-=back
-
-The default is determined by the C<resources.bugs> and C<resources.repository>
-values in F<META>.
-
-=back
-
-=cut
-
-my $opt_tracker;
-
-GetOptions( 'tracker=s' => \$opt_tracker ) or exit 1;
-
-my $patch = $ARGV[0];
-
-die 'Err: Provide a valid patch file' if !$patch;
-
-my $meta;
-$meta = CPAN::Meta->load_file('META.json') if -e 'META.json';
-$meta //= CPAN::Meta->load_file('META.yml') if -e 'META.jml';
-
-sub get_subject {
- my $term = Term::ReadLine->new('forward-patch');
-
- my $subject .= basename($patch);
- $subject =~ s/(\_|\-)/\ /g;
- $subject =~ s/(\.patch|\.diff)//;
-
- return $term->readline( 'Subject:', "[PATCH] $subject" );
-}
-
-my $name = $ENV{'DEBFULLNAME'};
-my $email
- = $ENV{'DEBEMAIL'}
- || $ENV{'EMAIL'}
- || die "Err: Set a valid email address";
-
-if ( !$name ) {
- $name = ( getpwuid($<) )[6];
- $name =~ s/,.*//;
-}
-
-sub submit_cpan_rt {
- my $dist = shift;
-
- $dist ||= $meta->name if $meta;
-
- 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 "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 $subject = get_subject();
-
- # RT::Client::REST does not support attachments, we need to use the email interface
- # 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";
-
- $body = edit_message($body);
-
- # 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" );
-}
-
-sub submit_github {
-
- eval { require Net::GitHub; }
- or die "Net::GitHub not available.\n"
- . "Please install libnet-github-perl and try again.";
-
- die "github cannot be used without META.\n" unless $meta;
- die "github requires DPT_GITHUB_OAUTH setting.\n"
- . "See dpt-config(5) and dpt-github-oauth.\n"
- unless $ENV{DPT_GITHUB_OAUTH};
-
- my $url;
- $url = $meta->resources->{bugtracker}{web} if $meta->resources->{bugtracker};
- die "Unable to determine github issue tracker URL.\n" unless $url;
-
- my ( $gh_user, $gh_repo, $gh_opts )
- = $url =~ m{^https?://github.com/([^/]+)/([^/]+)/issues(?:/?|\?(.*))$};
- my $gh_labels = '';
- $gh_labels = $1 if $gh_opts and $gh_opts =~ m{labels=([^;&]+)};
-
- die "Unable to determine github user and reposotory\n" . "from $url"
- unless $gh_user and $gh_repo;
-
- my $dist = $meta->name;
-
- # prepare subject
- my $subject = get_subject();
-
- # prepare body
- my $body
- = "In Debian we are currently applying the following patch to $dist.\n";
- $body .= "We thought you might be interested in it too.\n\n";
-
- # relative patch name
- my $rpn = Cwd::abs_path($patch);
- $rpn =~ s{(?:^|.+/)debian/patches/}{};
-
- my $package = basename(getcwd());
-
- my $alioth = 'https://anonscm.debian.org/cgit/pkg-perl/packages';
-
- $body .= "The patch is located at $alioth/$package.git/plain/debian/patches/$rpn\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:/;
- $line =~ s/^Description:\s*//;
- $line =~ s/^ //; # continuation lines
- $body .= ' ' . $line; # indented
- }
-
- close $patch_fh or warn "Cannot close $patch from reading: $!";
-
- $body .= "\nThanks in advance,\n";
- $body .= " $name, Debian Perl Group\n";
-
- $body = edit_message($body);
-
- # now create the issue
- my $gh = Net::GitHub->new( # Net::GitHub::V3
- access_token => $ENV{DPT_GITHUB_OAUTH},
- );
-
- $gh->set_default_user_repo( $gh_user, $gh_repo );
-
- my $i = $gh->issue->create_issue(
- { title => $subject,
- body => $body,
- labels => [ split(/,/, $gh_labels) ],
- }
- );
-
- mark_patch_as_forwarded( $i->{html_url} );
-}
-
-sub edit_message {
- my $body = shift;
-
- $body
- = "# Feel free to edit the message contents to your liking.\n"
- . "# Fiddling with the patch itself is probably a bad idea.\n"
- . "# Heading lines starting with '#' are ignored\n"
- . "# Empty message aborts the process\n"
- . $body;
-
- $body = Proc::InvokeEditor->edit($body);
-
- $body =~ s/^#[^\n]*\n//mg while $body =~ /^#/;
-
- die "Empty message. Terminating.\n" unless $body;
-
- return $body;
-}
-
-sub mark_patch_as_forwarded {
- my $url = shift;
-
- my @lines = read_file($patch);
- if ( $lines[0] =~ /^Description:/ ) {
- my @result;
- while ( @lines and $lines[0] =~ /^(?:\h|[a-z][a-z-]*:)/i ) {
- push @result, shift @lines;
- }
-
- push @result, "Forwarded: $url\n";
-
- push @result, @lines;
-
- write_file( $patch, @result );
-
- print "Patch marked as forwarded to\n";
- print " $url\n";
- }
- else {
- warn "Patch formatting not recognized.";
- warn "Please add suitable marking that the patch was forwarded to\n";
- warn " $url\n";
- }
-}
-
-sub detect_tracker {
- # discover the appropriate tracker
-
- unless ( $meta ) {
- warn "No META file found. Falling back to rt.cpan.org\n";
- return 'cpan';
- }
-
- my $url;
- $url = $meta->resources->{bugtracker}{web}
- if $meta->resources
- and $meta->resources->{bugtracker};
-
- # bad idea, as the issue tracker may be disabled
- #$url = $meta->resources->{repository}{web}
- # if not $url
- # and $meta->resources
- # and $meta->resources->{repository};
-
- return 'cpan' if $url and $url =~ /rt\.cpan\.org/;
- return 'github' if $url and $url =~ /github/;
-
- warn "Unable to determine bug tracker from META.\n";
- warn "Falling back to rt.cpan.org.\n";
- return 'cpan';
-}
-
-$opt_tracker ||= detect_tracker();
-
-if ( $opt_tracker eq 'cpan' ) {
- submit_cpan_rt( $ARGV[1] );
-}
-elsif ( $opt_tracker eq 'github' ) {
- submit_github( $ARGV[1] );
-}
-else {
- die "Unsupported tracker: '$opt_tracker'\n";
-}
-
-=head1 AUTHOR
-
-Alessandro Ghedini <ghedo at debian.org>
-
-=head1 LICENSE AND COPYRIGHT
-
-Copyright 2011 Alessandro Ghedini.
-Copyright 2014 Damyan Ivanov.
-Copyright 2014 Salvatore Bonaccorso.
-
-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
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/pkg-perl-tools.git
More information about the Pkg-perl-cvs-commits
mailing list