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