File Coverage

lib/CPANPLUS/Internals/Constants/Report.pm
Criterion Covered Total %
statement 124 170 72.9
branch 25 38 65.7
condition 8 14 57.1
subroutine 29 29 100.0
pod n/a
total 186 251 74.1


line stmt bran cond sub pod time code
1             package CPANPLUS::Internals::Constants::Report;
2              
3 21     20   595 use strict;
  21         51  
  20         720  
4 20     20   128 use CPANPLUS::Error;
  20         51  
  22         1918  
5              
6 22     20   164 use File::Spec;
  22         59  
  22         740  
7 76     20   564 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  21         51  
  21         193  
8              
9             require Exporter;
10 21     20   5435 use vars qw[$VERSION @ISA @EXPORT];
  22         100  
  20         1626  
11              
12 20     20   150 use Package::Constants;
  20         47  
  20         2766  
13              
14             $VERSION = "0.9914";
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   153 use constant GRADE_FAIL => 'fail';
  20         58  
  20         1581  
53 24     20   1897 use constant GRADE_PASS => 'pass';
  24         92  
  23         1120  
54 21     20   161 use constant GRADE_NA => 'na';
  20         49  
  20         1297  
55 20     20   157 use constant GRADE_UNKNOWN => 'unknown';
  24         567  
  24         1099  
56              
57 22         1000 use constant MAX_REPORT_SEND
58 21     20   124 => 2;
  23         68  
59              
60 20         1965 use constant CPAN_TESTERS_EMAIL
61 21     20   136 => 'cpan-testers@perl.org';
  20         90  
62              
63             ### the cpan mail account for this user ###
64             use constant CPAN_MAIL_ACCOUNT
65             => sub {
66 0 50       0 my $username = shift or return;
67 0         0 return $username . '@cpan.org';
68 20     20   170 };
  20         106  
  20         3914  
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 1 50       561 my $mod = shift or return;
76 0         0 my $name = $mod->module;
77 0         0 my $specific;
78 0         0 for my $platform (keys %OS) {
79 0 100       0 if( $name =~ /^$platform\b/i ) {
80             # beware the Mac != MAC
81 0 50 33     0 next if($platform eq 'Mac' &&
82             $name !~ /^$platform\b/);
83 2         428 $specific++;
84 2 50       236 return 1 if
85             $^O =~ /^(?:$OS{$platform})$/
86             }
87             };
88 0 100       0 return $specific ? 0 : 1;
89 24     20   1459 };
  24         113  
  23         3477  
90              
91             use constant UNSUPPORTED_OS
92             => sub {
93 0 0       0 my $buffer = shift or return;
94 2 50       2034 if( $buffer =~
95             /No support for OS|OS unsupported/im ) {
96 2         10 return 1;
97             }
98 2         20 return 0;
99 20     20   210 };
  20         48  
  20         3506  
100              
101             use constant PERL_VERSION_TOO_LOW
102             => sub {
103 2 100       4 my $buffer = shift or return;
104             # ExtUtils::MakeMaker format
105 2 50       3 if( $buffer =~
106             /Perl .*? required--this is only .*?/m ) {
107 2         5 return 1;
108             }
109             # Module::Build format
110 2 100       13 if( $buffer =~
111             /ERROR:( perl:)? Version .*?( of perl)? is installed, but we need version >= .*?/m ) {
112 2         8 return 1;
113             }
114 0         0 return 0;
115 22     20   185 };
  22         55  
  22         4129  
116              
117             use constant NO_TESTS_DEFINED
118             => sub {
119 4 100       59 my $buffer = shift or return;
120 4 50 66     77 if( $buffer =~
      66        
121             /(No tests defined( for [\w:]+ extension)?\.)/
122             and $buffer !~ /\*\.t/m and
123             $buffer !~ /test\.pl/m
124             ) {
125 0         0 return $1
126             }
127              
128 4         29 return;
129 20     20   167 };
  20         49  
  20         2019  
130              
131             ### what stage did the test fail? ###
132             use constant TEST_FAIL_STAGE
133             => sub {
134 0 50       0 my $buffer = shift or return;
135 0 50       0 return $buffer =~ /(MAKE [A-Z]+).*/
136             ? lc $1 :
137             'fetch';
138 21     20   1584 };
  21         57  
  20         4993  
139              
140              
141             use constant MISSING_PREREQS_LIST
142             => sub {
143 0         0 my $buffer = shift;
144 1         3366 my $last = ( split /\[ERROR\] .+? MAKE TEST/, $buffer )[-1];
145 1         11 my @list = map { s/.pm$//; s|/|::|g; $_ }
  0         0  
  0         0  
  0         0  
146             ($last =~
147             m/\bCan\'t locate (\S+) in \@INC/g);
148              
149             ### make sure every missing prereq is only
150             ### listed once
151 0         0 { my %seen;
  0         0  
152 0         0 @list = grep { !$seen{$_}++ } @list
  0         0  
153             }
154              
155 2         6421 return @list;
156 20     20   168 };
  20         45  
  20         3450  
157              
158             use constant MISSING_EXTLIBS_LIST
159             => sub {
160 2         15 my $buffer = shift;
161 2         15 my @list =
162             ($buffer =~
163             m/No library found for -l([-\w]+)/g);
164              
165 0         0 return @list;
166 22     20   192 };
  22         56  
  22         1855  
167              
168             use constant REPORT_MESSAGE_HEADER
169             => sub {
170 0         0 my ($version, $author) = @_;
171 0         0 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         49  
  20         2064  
181              
182             use constant REPORT_MESSAGE_FAIL_HEADER
183             => sub {
184 0         0 my($stage, $buffer) = @_;
185 0         0 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   179 };
  20         81  
  20         2309  
198              
199             use constant REPORT_MESSAGE_PASS_HEADER
200             => sub {
201 1         3261 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   151 };
  20         55  
  20         4661  
215              
216             use constant REPORT_MISSING_PREREQS
217             => sub {
218 0         0 my ($author,$email,@missing) = @_;
219 1 100 66     1870 $author = ($author && $email)
220             ? "$author ($email)"
221             : 'Your Name Here';
222              
223 0         0 my $modules = join "\n", @missing;
224             my $prereqs = join "\n",
225 0         0 map {"\t'$_'\t=> '0',".
  0         0  
226             " # or a minimum working version"}
227             @missing;
228              
229 0         0 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   158 };
  20         61  
  20         1960  
252              
253             use constant REPORT_MISSING_TESTS
254             => sub {
255 0         0 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__