1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use File::Basename qw( dirname );
BEGIN {
plan skip_all
=> "Set AUTHOR_TESTING to perform these tests"
unless $ENV{AUTHOR_TESTING};
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@example.com',
mailto => 'upstream@example.com',
);
my $patch = dirname(__FILE__) . '/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,
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,
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' );
like(
$msg->prepare_body(),
qr{^https://salsa\.debian\.org/perl-team/modules/packages/pkg-perl-tools/raw/master/t/dummy\.txt\.patch$}m,
'patch URL'
);
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,
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' );
like(
$msg->prepare_body(),
qr{^https://salsa\.debian\.org/perl-team/modules/packages/pkg-perl-tools/raw/master/t/dummy\.txt\.patch$}m,
'patch URL'
);
done_testing();
};
done_testing();
|
