[pkg-perl-tools] 03/04: Add a test for Debian::PkgPerl::Message
Alex Muntada
alexm-guest at moszumanska.debian.org
Fri Dec 2 23:27:25 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 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
More information about the Pkg-perl-cvs-commits
mailing list