This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
294de6923691037d556163a227bce833f7e95cbf
[perl5.git] / cpan / CPANPLUS / lib / CPANPLUS / Internals / Constants / Report.pm
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
14 ### for the version
15 require CPANPLUS::Internals;
16
17 $VERSION    = $CPANPLUS::Internals::VERSION = $CPANPLUS::Internals::VERSION;
18 @ISA        = qw[Exporter];
19 @EXPORT     = Package::Constants->list( __PACKAGE__ );
20
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 =~ /^$platform\b/i ) {
84                                         # beware the Mac != MAC
85                                         next if($platform eq 'Mac' &&
86                                                 $name !~ /^$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 $last = ( split /\[ERROR\] .+? MAKE TEST/, $buffer )[-1];
149                                 my @list = map { s/.pm$//; s|/|::|g; $_ }
150                                     ($last =~
151                                         m/\bCan\'t locate (\S+) in \@INC/g);
152
153                                 ### make sure every missing prereq is only
154                                 ### listed once
155                                 {   my %seen;
156                                     @list = grep { !$seen{$_}++ } @list
157                                 }
158
159                                 return @list;
160                             };
161
162 use constant MISSING_EXTLIBS_LIST
163                             => sub {
164                                 my $buffer = shift;
165                                 my @list =
166                                     ($buffer =~
167                                         m/No library found for -l([-\w]+)/g);
168
169                                 return @list;
170                             };
171
172 use constant REPORT_MESSAGE_HEADER
173                             => sub {
174                                 my ($version, $author) = @_;
175                                 return << ".";
176
177 Dear $author,
178
179 This is a computer-generated error report created automatically by
180 CPANPLUS, version $version. Testers personal comments may appear
181 at the end of this report.
182
183 .
184                             };
185
186 use constant REPORT_MESSAGE_FAIL_HEADER
187                             => sub {
188                                 my($stage, $buffer) = @_;
189                                 return << ".";
190
191 Thank you for uploading your work to CPAN.  However, it appears that
192 there were some problems testing your distribution.
193
194 TEST RESULTS:
195
196 Below is the error stack from stage '$stage':
197
198 $buffer
199
200 .
201                             };
202
203 use constant REPORT_MESSAGE_PASS_HEADER
204                             => sub {
205                                 my($stage, $buffer) = @_;
206                                 return << ".";
207
208 Thank you for uploading your work to CPAN.  Congratulations!
209 All tests were successful.
210
211 TEST RESULTS:
212
213 Below is the error stack from stage '$stage':
214
215 $buffer
216
217 .
218                             };
219
220 use constant REPORT_MISSING_PREREQS
221                             => sub {
222                                 my ($author,$email,@missing) = @_;
223                                 $author = ($author && $email)
224                                             ? "$author ($email)"
225                                             : 'Your Name Here';
226
227                                 my $modules = join "\n", @missing;
228                                 my $prereqs = join "\n",
229                                     map {"\t'$_'\t=> '0',".
230                                          " # or a minimum working version"}
231                                     @missing;
232
233                                 return << ".";
234
235 MISSING PREREQUISITES:
236
237 It was observed that the test suite seem to fail without these modules:
238
239 $modules
240
241 As such, adding the prerequisite module(s) to 'PREREQ_PM' in your
242 Makefile.PL should solve this problem.  For example:
243
244 WriteMakefile(
245     AUTHOR      => '$author',
246     ... # other information
247     PREREQ_PM   => {
248 $prereqs
249     }
250 );
251
252 Thanks! :-)
253
254 .
255                             };
256
257 use constant REPORT_MISSING_TESTS
258                             => sub {
259                                 return << ".";
260 RECOMMENDATIONS:
261
262 It would be very helpful if you could include even a simple test
263 script in the next release, so people can verify which platforms
264 can successfully install them, as well as avoid regression bugs?
265
266 A simple 't/use.t' that says:
267
268 #!/usr/bin/env perl -w
269 use strict;
270 use Test;
271 BEGIN { plan tests => 1 }
272
273 use Your::Module::Here; ok(1);
274 exit;
275 __END__
276
277 would be appreciated.  If you are interested in making a more robust
278 test suite, please see the Test::Simple, Test::More and Test::Tutorial
279 documentation at <http://search.cpan.org/dist/Test-Simple/>.
280
281 Thanks!  :-)
282
283 .
284                             };
285
286 use constant REPORT_LOADED_PREREQS
287                             => sub {
288                                 my $mod = shift;
289                                 my $cb  = $mod->parent;
290                                 my $prq = $mod->status->prereqs || {};
291
292                                 ### not every prereq may be coming from CPAN
293                                 ### so maybe we wont find it in our module
294                                 ### tree at all...
295                                 ### skip ones that cant be found in teh list
296                                 ### as reported in #12723
297                                 my @prq = grep { defined }
298                                           map { $cb->module_tree($_) }
299                                           sort keys %$prq;
300
301                                 ### no prereqs?
302                                 return '' unless @prq;
303
304                                 ### some apparently, list what we loaded
305                                 my $str = << ".";
306 PREREQUISITES:
307
308 Here is a list of prerequisites you specified and versions we
309 managed to load:
310
311 .
312                                 $str .= join '',
313                                         map { sprintf "\t%s %-30s %8s %8s\n",
314                                               @$_
315
316                                         } [' ', 'Module Name', 'Have', 'Want'],
317                                           map { my $want = $prq->{$_->name};
318                                               [ do { $_->is_uptodate(
319                                                     version => $want
320                                                    ) ? ' ' : '!'
321                                                 },
322                                                 $_->name,
323                                                 $_->installed_version,
324                                                 $want
325                                               ],
326                                         ### might be empty entries in there
327                                         } grep { $_ } @prq;
328
329                                 return $str;
330                             };
331
332 use constant REPORT_TOOLCHAIN_VERSIONS
333                             => sub {
334                                 my $mod = shift;
335                                 my $cb  = $mod->parent;
336                                 #die unless $cb->isa('CPANPLUS::Backend');
337
338                                 my @toolchain_modules= qw(
339                                     CPANPLUS
340                                     CPANPLUS::Dist::Build
341                                     Cwd
342                                     ExtUtils::CBuilder
343                                     ExtUtils::Command
344                                     ExtUtils::Install
345                                     ExtUtils::MakeMaker
346                                     ExtUtils::Manifest
347                                     ExtUtils::ParseXS
348                                     File::Spec
349                                     Module::Build
350                                     Test::Harness
351                                     Test::More
352                                     version
353                                 );
354
355                                 my @toolchain =
356                                           grep { $_ } #module_tree returns '' when module is not found
357                                           map { $cb->module_tree($_) }
358                                           sort @toolchain_modules;
359
360                                 ### no prereqs?
361                                 return '' unless @toolchain;
362
363                                 ### toolchain modules
364                                 my $str = << ".";
365
366 Perl module toolchain versions installed:
367 .
368                                 $str .= join '',
369                                         map { sprintf "\t%-30s %8s\n",
370                                               @$_
371
372                                         } ['Module Name', 'Have'],
373                                           map {
374                                               [ $_->name,
375                                                 $_->installed_version,
376                                               ],
377                                         ### might be empty entries in there
378                                         } @toolchain;
379
380                                 return $str;
381                             };
382
383
384 use constant REPORT_TESTS_SKIPPED
385                             => sub {
386                                 return << ".";
387
388 ******************************** NOTE ********************************
389 ***                                                                ***
390 ***    The tests for this module were skipped during this build    ***
391 ***                                                                ***
392 **********************************************************************
393
394 .
395                             };
396
397 use constant REPORT_MESSAGE_FOOTER
398                             => sub {
399                                 return << ".";
400
401 ******************************** NOTE ********************************
402 The comments above are created mechanically, possibly without manual
403 checking by the sender.  As there are many people performing automatic
404 tests on each upload to CPAN, it is likely that you will receive
405 identical messages about the same problem.
406
407 If you believe that the message is mistaken, please reply to the first
408 one with correction and/or additional informations, and do not take
409 it personally.  We appreciate your patience. :)
410 **********************************************************************
411
412 Additional comments:
413
414 .
415                              };
416
417 1;
418
419 # Local variables:
420 # c-indentation-style: bsd
421 # c-basic-offset: 4
422 # indent-tabs-mode: nil
423 # End:
424 # vim: expandtab shiftwidth=4: