This is an automated email from the git hooks/post-receive script.
fsfs pushed a commit to branch master
in repository pkg-perl-tools.
commit d22587bf81b2b4fd4eb94600f7f708f6d68c736e
Author: Florian Schlichting <f...@debian.org>
Date: Mon Nov 28 00:21:54 2016 +0100
forward: fall back to sending email when pause credentials cannot be read
---
TODO | 2 --
lib/Debian/PkgPerl/Message.pm | 7 +++++++
scripts/forward | 41 +++++++++++++++++++++--------------------
3 files changed, 28 insertions(+), 22 deletions(-)
diff --git a/TODO b/TODO
index 50e0cf6..5c0547a 100644
--- a/TODO
+++ b/TODO
@@ -17,8 +17,6 @@ TODOS:
- lintian check: ensure that arch-dep packages use M-A:same
- lintian check: check for unversioned 'perl' in Depends
- forward: set Forwarded (but not Bug) header when using --mailto
-- forward: automatically fall back to email when proper credentials are not
available
- (even without --use-mail)
- upstream-repo: s/http/https/ for github/cpan URLs on creation/updates ...
- push: push tags of native packages
- autopkgtest: smoke: the dummy package should "use strict;", otherwise:
diff --git a/lib/Debian/PkgPerl/Message.pm b/lib/Debian/PkgPerl/Message.pm
index 3b292be..1ec4d68 100644
--- a/lib/Debian/PkgPerl/Message.pm
+++ b/lib/Debian/PkgPerl/Message.pm
@@ -182,10 +182,17 @@ sub send_by_mail {
my $name = $self->{name};
my $email = $self->{email};
+ my $opt_dist = $self->{dist};
my $opt_mailto = $self->{mailto};
my $patch = $self->{info}{patch};
my $opt_tracker_url = $self->{url};
+ if (!$opt_mailto) {
+ warn "Bug tracker email address not found in META.\n";
+ $opt_mailto = 'bug-' . lc($opt_dist) . '@rt.cpan.org';
+ warn "Falling back to $opt_mailto\n";
+ }
+
my $from = "$name <$email>";
my $text = $self->prepare_body();
my $subject = $self->get_subject();
diff --git a/scripts/forward b/scripts/forward
index 8d9af8e..2dce65c 100755
--- a/scripts/forward
+++ b/scripts/forward
@@ -173,14 +173,6 @@ if ( $meta and $meta->resources and
$meta->resources->{bugtracker} ) {
$opt_mailto =~ s/ at /@/ if $opt_mailto;
}
-if ( $opt_use_mail and not $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'
@@ -278,8 +270,7 @@ sub detect_dist {
}
}
- close $dcopyright
- or warn "Cannot close debian/copyright from reading: $!";
+ close $dcopyright;
return;
}
@@ -289,9 +280,13 @@ my $rt_server = 'https://rt.cpan.org';
my %rt_login;
sub read_pause_credentials {
- open my $pauserc, '<',
- File::Spec->catfile( File::HomeDir->my_home, '.pause' )
- || die 'Could not open ~/.pause, supply credentials or --use-mail
instead';
+ my $pausefile = File::Spec->catfile( File::HomeDir->my_home, '.pause' );
+ unless ( -r $pausefile ) {
+ warn "Could not open ~/.pause, supply credentials to use REST
interface\n";
+ return 0;
+ }
+
+ open my $pauserc, '<', $pausefile;
while (<$pauserc>) {
chomp;
@@ -303,14 +298,15 @@ sub read_pause_credentials {
close $pauserc;
- die 'Err: Provide valid PAUSE credentials'
- if not $rt_login{'user'}
- or not $rt_login{'password'};
+ if (not $rt_login{'user'} or not $rt_login{'password'}) {
+ warn "Err: Provide valid PAUSE credentials\n";
+ return 0;
+ }
+
+ return 'pause credentials ok';
}
sub submit_cpan_rt {
- read_pause_credentials();
-
# prepare subject
my $subject = $message->get_subject();
@@ -434,7 +430,7 @@ sub mark_patch_as_forwarded {
}
if ( not $forwarded_set or not $bug_set ) {
- warn "Patch formatting not recognized.";
+ warn "Patch formatting not recognized.\n";
warn "Please make sure that the following headers are present:\n";
warn " Forwarded: $url\n";
warn " Bug: $url\n";
@@ -503,7 +499,12 @@ if ($opt_use_mail) {
$message->send_by_mail();
}
elsif ( $opt_tracker eq 'cpan' ) {
- submit_cpan_rt();
+ if ( read_pause_credentials() ) {
+ submit_cpan_rt();
+ } else {
+ warn "Falling back to email\n";
+ $message->send_by_mail();
+ }
}
elsif ( $opt_tracker eq 'github' ) {
submit_github();
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/pkg-perl-tools.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
