File Coverage

lib/CPANPLUS/Internals/Constants/Report.pm
Criterion Covered Total %
statement 106 147 72.1
branch 24 34 70.6
condition 8 14 57.1
subroutine 27 27 100.0
pod n/a
total 165 222 74.3


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