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 =~ /\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
 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 '',
 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(
 301                                                     version => $want
 302                                                    ) ? ' ' : '!'
 303                                                 },
 304                                                 $_->name,
 305                                                 $_->installed_version,
 306                                                 $want
 307                                               ],
 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: