[pkg-perl-tools] 01/04: forward: fall back to sending email when pause credentials cannot be read

[Florian Schlichting]

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 <fsfs at 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