File Coverage

lib/CPANPLUS/Internals/Constants/Report.pm
Criterion Covered Total %
statement 167 170 98.2
branch 26 38 68.4
condition 8 14 57.1
subroutine 29 29 100.0
pod n/a
total 230 251 91.6


line stmt bran cond sub pod time code
1             package CPANPLUS::Internals::Constants::Report;
2              
3 20     20   131 use strict;
  20         41  
  20         897  
4 20     20   108 use CPANPLUS::Error;
  20         64  
  20         1358  
5              
6 20     20   118 use File::Spec;
  20         51  
  20         864  
7 20     20   126 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  20         41  
  20         194  
8              
9             require Exporter;
10 20     20   6259 use vars qw[$VERSION @ISA @EXPORT];
  20         41  
  20         1402  
11              
12 20     20   130 use Package::Constants;
  20         42  
  20         3523  
13              
14             $VERSION = "0.9916";
15             @ISA = qw[Exporter];
16             @EXPORT = Package::Constants->list( __PACKAGE__ );
17              
18             ### OS to regex map ###
19             my %OS = (
20             Amiga => 'amigaos',
21             Atari => 'mint',
22             BSD => 'bsdos|bitrig|darwin|freebsd|openbsd|netbsd',
23             Be => 'beos',
24             BeOS => 'beos',
25             Cygwin => 'cygwin',
26             Darwin => 'darwin',
27             EBCDIC => 'os390|os400|posix-bc|vmesa',
28             HPUX => 'hpux',
29             Linux => 'linux',
30             MSDOS => 'dos|os2|MSWin32|cygwin',
31             'bin\\d*Mac'=> 'MacOS|darwin', # binMac, bin56Mac, bin58Mac...
32             Mac => 'MacOS|darwin',
33             MacPerl => 'MacOS',
34             MacOS => 'MacOS|darwin',
35             MacOSX => 'darwin',
36             MPE => 'mpeix',
37             MPEiX => 'mpeix',
38             OS2 => 'os2',
39             Plan9 => 'plan9',
40             RISCOS => 'riscos',
41             SGI => 'irix',
42             Solaris => 'solaris',
43             Unix => 'aix|bsdos|bitrig|darwin|dgux|dynixptx|freebsd|'.
44             'linux|hpux|machten|netbsd|next|openbsd|dec_osf|'.
45             'svr4|sco_sv|unicos|unicosmk|solaris|sunos',
46             VMS => 'VMS',
47             VOS => 'VOS',
48             Win32 => 'MSWin32|cygwin',
49             Win32API => 'MSWin32|cygwin',
50             );
51              
52 20     20   162 use constant GRADE_FAIL => 'fail';
  20         65  
  20         2632  
53 20     20   128 use constant GRADE_PASS => 'pass';
  20         61  
  20         1233  
54 20     20   115 use constant GRADE_NA => 'na';
  20         64  
  20         1114  
55 20     20   181 use constant GRADE_UNKNOWN => 'unknown';
  20         80  
  20         1271  
56              
57 20         1135 use constant MAX_REPORT_SEND
58 20     20   128 => 2;
  20         38  
59              
60 20         2028 use constant CPAN_TESTERS_EMAIL
61 20     20   107 => 'cpan-testers@perl.org';
  20         60  
62              
63             ### the cpan mail account for this user ###
64             use constant CPAN_MAIL_ACCOUNT
65             => sub {
66 1 50       223 my $username = shift or return;
67 1         4 return $username . '@cpan.org';
68 20     20   124 };
  20         48  
  20         4603  
69              
70             ### check if this module is platform specific and if we're on that
71             ### specific platform. Alternately, the module is not platform specific
72             ### and we're always OK to send out test results.
73             use constant RELEVANT_TEST_RESULT
74             => sub {
75 2 50       530 my $mod = shift or return;
76 2         11 my $name = $mod->module;
77 2         4 my $specific;
78 2         111 for my $platform (keys %OS) {
79 56 100       315 if( $name =~ /^$platform\b/i ) {
80             # beware the Mac != MAC
81 1 50 33     4 next if($platform eq 'Mac' &&
82             $name !~ /^$platform\b/);
83 1         3 $specific++;
84 1 50       12 return 1 if
85             $^O =~ /^(?:$OS{$platform})$/
86             }
87             };
88 2 100       23 return $specific ? 0 : 1;
89 20     20   139 };
  20         43  
  20         3593  
90              
91             use constant UNSUPPORTED_OS
92             => sub {
93 4 50       1016 my $buffer = shift or return;
94 4 100       49 if( $buffer =~
95             /No support for OS|OS unsupported/im ) {
96 3         14 return 1;
97             }
98 1         7 return 0;
99 20     20   143 };
  20         40  
  20         3996  
100              
101             use constant PERL_VERSION_TOO_LOW
102             => sub {
103 4 50       222 my $buffer = shift or return;
104             # ExtUtils::MakeMaker format
105 4 100       24 if( $buffer =~
106             /Perl .*? required--this is only .*?/m ) {
107 1         6 return 1;
108             }
109             # Module::Build format
110 3 100       26 if( $buffer =~
111             /ERROR:( perl:)? Version .*?( of perl)? is installed, but we need version >= .*?/m ) {
112 2         9 return 1;
113             }
114 1         3 return 0;
115 20     20   142 };
  20         42  
  20         7005  
116              
117             use constant NO_TESTS_DEFINED
118             => sub {
119 8 50       685 my $buffer = shift or return;
120 8 50 66     152 if( $buffer =~
      66        
121             /(No tests defined( for [\w:]+ extension)?\.)/
122             and $buffer !~ /\*\.t/m and
123             $buffer !~ /test\.pl/m
124             ) {
125 3         13 return $1
126             }
127              
128 5         213 return;
129 20     20   166 };
  20         51  
  20         2676  
130              
131             ### what stage did the test fail? ###
132             use constant TEST_FAIL_STAGE
133             => sub {
134 2 50       197 my $buffer = shift or return;
135 2 100       21 return $buffer =~ /(MAKE [A-Z]+).*/
136             ? lc $1 :
137             'fetch';
138 20     20   137 };
  20         43  
  20         4894  
139              
140              
141             use constant MISSING_PREREQS_LIST
142             => sub {
143 2         1948 my $buffer = shift;
144 2         11 my $last = ( split /\[ERROR\] .+? MAKE TEST/, $buffer )[-1];
145 2         26 my @list = map { s/.pm$//; s|/|::|g; $_ }
  2         8  
  2         6  
  2         6  
146             ($last =~
147             m/\bCan\'t locate (\S+) in \@INC/g);
148              
149             ### make sure every missing prereq is only
150             ### listed once
151 2         4 { my %seen;
  2         4  
152 2         4 @list = grep { !$seen{$_}++ } @list
  2         9  
153             }
154              
155 2         7 return @list;
156 20     20   198 };
  20         44  
  20         5423  
157              
158             use constant MISSING_EXTLIBS_LIST
159             => sub {
160 1         3129 my $buffer = shift;
161 1         46 my @list =
162             ($buffer =~
163             m/No library found for -l([-\w]+)/g);
164              
165 1         6 return @list;
166 20     20   160 };
  20         43  
  20         2426  
167              
168             use constant REPORT_MESSAGE_HEADER
169             => sub {
170 1         1491 my ($version, $author) = @_;
171 1         5 return << ".";
172              
173             Dear $author,
174              
175             This is a computer-generated error report created automatically by
176             CPANPLUS, version $version. Testers personal comments may appear
177             at the end of this report.
178              
179             .
180 20     20   130 };
  20         47  
  20         1987  
181              
182             use constant REPORT_MESSAGE_FAIL_HEADER
183             => sub {
184 1         2283 my($stage, $buffer) = @_;
185 1         5 return << ".";
186              
187             Thank you for uploading your work to CPAN. However, it appears that
188             there were some problems testing your distribution.
189              
190             TEST RESULTS:
191              
192             Below is the error stack from stage '$stage':
193              
194             $buffer
195              
196             .
197 20     20   121 };
  20         85  
  20         2062  
198              
199             use constant REPORT_MESSAGE_PASS_HEADER
200             => sub {
201 0         0 my($stage, $buffer) = @_;
202 0         0 return << ".";
203              
204             Thank you for uploading your work to CPAN. Congratulations!
205             All tests were successful.
206              
207             TEST RESULTS:
208              
209             Below is the error stack from stage '$stage':
210              
211             $buffer
212              
213             .
214 20     20   145 };
  20         61  
  20         6418  
215              
216             use constant REPORT_MISSING_PREREQS
217             => sub {
218 2         4196 my ($author,$email,@missing) = @_;
219 2 100 66     20 $author = ($author && $email)
220             ? "$author ($email)"
221             : 'Your Name Here';
222              
223 2         7 my $modules = join "\n", @missing;
224             my $prereqs = join "\n",
225 2         5 map {"\t'$_'\t=> '0',".
  2         8  
226             " # or a minimum working version"}
227             @missing;
228              
229 2         10 return << ".";
230              
231             MISSING PREREQUISITES:
232              
233             It was observed that the test suite seem to fail without these modules:
234              
235             $modules
236              
237             As such, adding the prerequisite module(s) to 'PREREQ_PM' in your
238             Makefile.PL should solve this problem. For example:
239              
240             WriteMakefile(
241             AUTHOR => '$author',
242             ... # other information
243             PREREQ_PM => {
244             $prereqs
245             }
246             );
247              
248             Thanks! :-)
249              
250             .
251 20     20   168 };
  20         51  
  20         2246  
252              
253             use constant REPORT_MISSING_TESTS
254             => sub {
255 1         2153 return << ".";
256             RECOMMENDATIONS:
257              
258             It would be very helpful if you could include even a simple test
259             script in the next release, so people can verify which platforms
260             can successfully install them, as well as avoid regression bugs?
261              
262             A simple 't/use.t' that says:
263              
264             #!/usr/bin/env perl -w
265             use strict;
266             use Test;
267             BEGIN { plan tests => 1 }
268              
269             use Your::Module::Here; ok(1);
270             exit;
271             __END__