[pkg-perl-tools] 03/04: Add a test for Debian::PkgPerl::Message

[Alex Muntada]

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 33e66b8ce088b1ae65e43d00076ebe9f0233eff3
Author: Alex Muntada <alexm at alexm.org>
Date:   Sat Dec 3 00:16:42 2016 +0100

    Add a test for Debian::PkgPerl::Message
---
 lib/Debian/PkgPerl/Message.pm |  24 ++++++++--
 t/message.t                   | 105 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 125 insertions(+), 4 deletions(-)

diff --git a/lib/Debian/PkgPerl/Message.pm b/lib/Debian/PkgPerl/Message.pm
index 2056b03..f1c4d81 100644
--- a/lib/Debian/PkgPerl/Message.pm
+++ b/lib/Debian/PkgPerl/Message.pm
@@ -35,7 +35,15 @@ sub new {
     my $class = shift;
     my %params = @_;
 
-    return bless \%params, $class;
+    my %obj = (
+        # defaults
+        interactive => 1,
+
+        # caller params
+        %params,
+    );
+
+    return bless \%obj, $class;
 }
 
 sub get_subject {
@@ -49,9 +57,14 @@ sub get_subject {
     $default = "[PATCH] $default"
         if $patch and $default !~ /\[PATCH\]/ and $opt_tracker ne 'github';
 
-    my $term = Term::ReadLine->new('forward');
+    my $subject = $default;
+
+    if ( $self->{interactive} ) {
+        my $term = Term::ReadLine->new('forward');
+        $subject = $term->readline( 'Subject: ', $default );
+    }
 
-    return $term->readline( 'Subject: ', $default );
+    return $subject;
 }
 
 sub edit_message {
@@ -158,7 +171,10 @@ sub prepare_body {
     $body .= "\nThanks for considering,\n";
     $body .= wrap( '  ', '  ', "$name,\nDebian Perl Group\n" );
 
-    return $self->edit_message($body);
+    $body = $self->edit_message($body)
+        if $self->{interactive};
+
+    return $body;
 }
 
 sub send_by_mail {
diff --git a/t/message.t b/t/message.t
new file mode 100644
index 0000000..07082af
--- /dev/null
+++ b/t/message.t
@@ -0,0 +1,105 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    plan skip_all
+        => "Set AUTHOR_TESTING and DPT_PACKAGES to perform these tests"
+        unless $ENV{AUTHOR_TESTING}
+        and -d $ENV{DPT_PACKAGES};;
+
+    plan skip_all
+        => "These tests require a working Debian::PkgPerl::Message"
+        unless eval { use Debian::PkgPerl::Message; 1 };
+}
+
+# Defaults
+my %params = (
+    interactive => 0,
+    dist        => 'pkg-perl-dummy',
+    name        => 'DPT Tester',
+    email       => 'test at example.com',
+    mailto      => 'upstream at example.com',
+);
+
+my $patch = "$ENV{DPT_PACKAGES}/pkg-perl-tools/t/dummy.txt.patch";
+
+subtest 'Test bug message' => sub {
+    plan skip_all
+        => "Bug tests require a working Debian::PkgPerl::Bug"
+         . " and LWP::Simple"
+        unless eval { use Debian::PkgPerl::Bug; 1 }
+        and eval { use LWP::Simple; 1 };
+
+    use Test::RequiresInternet ( 'bugs.debian.org' => 80 );
+    use Test::RequiresInternet ( 'bugs.debian.org' => 443 );
+
+    my $html = get('https://bugs.debian.org/src:pkg-perl-tools');
+    my @list = $html =~ /<a href="bugreport\.cgi\?bug=(\d+)">#\1<\/a>/g;
+    my $bug = $list[0];
+
+    my %info = Debian::PkgPerl::Bug->new( bug => $bug )
+        ->retrieve_bug_info();
+
+    my $msg = new_ok( 'Debian::PkgPerl::Message', [
+        %params,
+        bug     => $bug,
+        info    => \%info,
+        tracker => 'github',
+    ]);
+
+    like( $msg->get_subject(), qr/$info{Subject}/, 'bug subject' );
+    like( $msg->prepare_body(), qr/bugs\.debian\.org\/$bug/m, 'bug body' );
+
+    done_testing();
+};
+
+subtest 'Test patch message to GitHub' => sub {
+    plan skip_all
+        => "Patch tests require a working Debian::PkgPerl::Patch"
+        unless eval { require Debian::PkgPerl::Patch; 1 };
+
+    my %info = Debian::PkgPerl::Patch->new( patch => $patch )
+        ->retrieve_patch_info();
+
+    my $msg = new_ok( 'Debian::PkgPerl::Message', [
+        %params,
+        patch   => $patch,
+        info    => \%info,
+        tracker => 'github',
+        url     => 'https://github.com/alexm/pkg-perl-dummy/issues',
+    ]);
+
+    like( $msg->get_subject(), qr/$info{Subject}/, 'patch subject' );
+    unlike( $msg->prepare_body(), qr/^(Description|Author)/m, 'patch body' );
+
+    done_testing();
+};
+
+
+subtest 'Test patch message to CPAN' => sub {
+    plan skip_all
+        => "Patch tests require a working Debian::PkgPerl::Patch"
+        unless eval { require Debian::PkgPerl::Patch; 1 };
+
+    my %info = Debian::PkgPerl::Patch->new( patch => $patch )
+        ->retrieve_patch_info();
+
+    my $msg = new_ok( 'Debian::PkgPerl::Message', [
+        %params,
+        patch   => $patch,
+        info    => \%info,
+        tracker => 'cpan',
+        url     => 'https://rt.cpan.org/Public/Dist/Display.html?Name=DUMMY',
+    ]);
+
+    like( $msg->get_subject(), qr/$info{Subject}/, 'patch subject' );
+    like( $msg->prepare_body(), qr/^(Description|Author)/m, 'patch body' );
+
+    done_testing();
+};
+
+done_testing();

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/pkg-perl-tools.git