[p5sagit/p5-mst-13.2.git] / ext / CPANPLUS / lib / CPANPLUS / Internals / Constants / Report.pm

package CPANPLUS::Internals::Constants::Report;

use strict;
use CPANPLUS::Error;

use File::Spec;
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';

require Exporter;
use vars    qw[$VERSION @ISA @EXPORT];

use Package::Constants;

### for the version
require CPANPLUS::Internals;

$VERSION    = $CPANPLUS::Internals::VERSION = $CPANPLUS::Internals::VERSION;
@ISA        = qw[Exporter];
@EXPORT     = Package::Constants->list( __PACKAGE__ );


### OS to regex map ###
my %OS = (
    Amiga       => 'amigaos',
    Atari       => 'mint',
    BSD         => 'bsdos|darwin|freebsd|openbsd|netbsd',
    Be          => 'beos',
    BeOS        => 'beos',
    Cygwin      => 'cygwin',
    Darwin      => 'darwin',
    EBCDIC      => 'os390|os400|posix-bc|vmesa',
    HPUX        => 'hpux',
    Linux       => 'linux',
    MSDOS       => 'dos|os2|MSWin32|cygwin',
    'bin\\d*Mac'=> 'MacOS|darwin', # binMac, bin56Mac, bin58Mac...
    Mac         => 'MacOS|darwin',
    MacPerl     => 'MacOS',
    MacOS       => 'MacOS|darwin',
    MacOSX      => 'darwin',
    MPE         => 'mpeix',
    MPEiX       => 'mpeix',
    OS2         => 'os2',
    Plan9       => 'plan9',
    RISCOS      => 'riscos',
    SGI         => 'irix',
    Solaris     => 'solaris',
    Unix        => 'aix|bsdos|darwin|dgux|dynixptx|freebsd|'.
                   'linux|hpux|machten|netbsd|next|openbsd|dec_osf|'.
                   'svr4|sco_sv|unicos|unicosmk|solaris|sunos',
    VMS         => 'VMS',
    VOS         => 'VOS',
    Win32       => 'MSWin32|cygwin',
    Win32API    => 'MSWin32|cygwin',
);

use constant GRADE_FAIL     => 'fail';
use constant GRADE_PASS     => 'pass';
use constant GRADE_NA       => 'na';
use constant GRADE_UNKNOWN  => 'unknown';

use constant MAX_REPORT_SEND
                            => 2;

use constant CPAN_TESTERS_EMAIL
                            => 'cpan-testers@perl.org';

### the cpan mail account for this user ###
use constant CPAN_MAIL_ACCOUNT
                            => sub {
                                my $username = shift or return;
                                return $username . '@cpan.org';
                            };

### check if this module is platform specific and if we're on that
### specific platform. Alternately, the module is not platform specific
### and we're always OK to send out test results.
use constant RELEVANT_TEST_RESULT
                            => sub {
                                my $mod  = shift or return;
                                my $name = $mod->module;
                                my $specific;
                                for my $platform (keys %OS) {
                                    if( $name =~ /\b$platform\b/i ) {
                                        # beware the Mac != MAC
                                        next if($platform eq 'Mac' &&
                                                $name !~ /\b$platform\b/);
                                        $specific++;
                                        return 1 if
                                            $^O =~ /^(?:$OS{$platform})$/
                                    }
                                };
                                return $specific ? 0 : 1;
                            };

use constant UNSUPPORTED_OS
                            => sub {
                                my $buffer = shift or return;
                                if( $buffer =~
                                        /No support for OS|OS unsupported/im ) {
                                    return 1;
                                }
                                return 0;
                          };                                            

use constant PERL_VERSION_TOO_LOW
                            => sub {
                                my $buffer = shift or return;
                                # ExtUtils::MakeMaker format
                                if( $buffer =~
                                        /Perl .*? required--this is only .*?/m ) {
                                    return 1;
                                }
                                # Module::Build format
                                if( $buffer =~
                                        /ERROR:( perl:)? Version .*?( of perl)? is installed, but we need version >= .*?/m ) {
                                    return 1;
                                }
                                return 0;
                          };                                            

use constant NO_TESTS_DEFINED
                            => sub {
                                my $buffer = shift or return;
                                if( $buffer =~
                                  /(No tests defined( for [\w:]+ extension)?\.)/
                                  and $buffer !~ /\*\.t/m and
                                      $buffer !~ /test\.pl/m
                                ) { 
                                    return $1 
                                }
                                
                                return;
                            };

### what stage did the test fail? ###
use constant TEST_FAIL_STAGE
                            => sub {
                                my $buffer = shift or return;
                                return $buffer =~ /(MAKE [A-Z]+).*/
                                    ? lc $1 :
                                    'fetch';
                            };


use constant MISSING_PREREQS_LIST
                            => sub {
                                my $buffer = shift;
                                my @list = map { s/.pm$//; s|/|::|g; $_ }
                                    ($buffer =~
                                        m/\bCan\'t locate (\S+) in \@INC/g);
                                
                                ### make sure every missing prereq is only 
                                ### listed ones
                                {   my %seen;
                                    @list = grep { !$seen{$_}++ } @list
                                }

                                return @list;
                            };

use constant MISSING_EXTLIBS_LIST
                            => sub {
                                my $buffer = shift;
                                my @list = 
                                    ($buffer =~
                                        m/No library found for -l([-\w]+)/g);

                                return @list;
                            };

use constant REPORT_MESSAGE_HEADER
                            => sub {
                                my ($version, $author) = @_;
                                return << ".";

Dear $author,
    
This is a computer-generated error report created automatically by
CPANPLUS, version $version. Testers personal comments may appear 
at the end of this report.

.
                            };

use constant REPORT_MESSAGE_FAIL_HEADER
                            => sub {
                                my($stage, $buffer) = @_;
                                return << ".";

Thank you for uploading your work to CPAN.  However, it appears that
there were some problems testing your distribution.

TEST RESULTS:

Below is the error stack from stage '$stage':

$buffer

.
                            };

use constant REPORT_MISSING_PREREQS
                            => sub {
                                my ($author,$email,@missing) = @_;
                                $author = ($author && $email) 
                                            ? "$author ($email)" 
                                            : 'Your Name Here';
                                
                                my $modules = join "\n", @missing;
                                my $prereqs = join "\n", 
                                    map {"\t'$_'\t=> '0',".
                                         " # or a minimum working version"}
                                    @missing;

                                return << ".";

MISSING PREREQUISITES:

It was observed that the test suite seem to fail without these modules:

$modules

As such, adding the prerequisite module(s) to 'PREREQ_PM' in your
Makefile.PL should solve this problem.  For example:

WriteMakefile(
    AUTHOR      => '$author',
    ... # other information
    PREREQ_PM   => {
$prereqs
    }
);

Thanks! :-)

.
                            };

use constant REPORT_MISSING_TESTS
                            => sub {
                                return << ".";
RECOMMENDATIONS:

It would be very helpful if you could include even a simple test 
script in the next release, so people can verify which platforms
can successfully install them, as well as avoid regression bugs?

A simple 't/use.t' that says:

#!/usr/bin/env perl -w
use strict;
use Test;
BEGIN { plan tests => 1 }

use Your::Module::Here; ok(1);
exit;
__END__

would be appreciated.  If you are interested in making a more robust
test suite, please see the Test::Simple, Test::More and Test::Tutorial
documentation at <http://search.cpan.org/dist/Test-Simple/>.

Thanks!  :-)

.
                            };

use constant REPORT_LOADED_PREREQS 
                            => sub {
                                my $mod = shift;
                                my $cb  = $mod->parent;
                                my $prq = $mod->status->prereqs || {};

                                ### not every prereq may be coming from CPAN
                                ### so maybe we wont find it in our module
                                ### tree at all... 
                                ### skip ones that cant be found in teh list
                                ### as reported in #12723
                                my @prq = grep { defined }
                                          map { $cb->module_tree($_) }
                                          sort keys %$prq;
                                
                                ### no prereqs?
                                return '' unless @prq;

                                ### some apparently, list what we loaded
                                my $str = << ".";
PREREQUISITES:

Here is a list of prerequisites you specified and versions we 
managed to load:
                                
.
                                $str .= join '', 
                                        map { sprintf "\t%s %-30s %8s %8s\n", 
                                              @$_
                                        
                                        } [' ', 'Module Name', 'Have', 'Want'],
                                          map { my $want = $prq->{$_->name};
                                              [ do { $_->is_uptodate( 
                                                    version => $want
                                                   ) ? ' ' : '!' 
                                                },
                                                $_->name,
                                                $_->installed_version,
                                                $want
                                              ],
                                        ### might be empty entries in there
                                        } grep { defined $_ } @prq;   
                                
                                return $str;
                            };

use constant REPORT_TESTS_SKIPPED 
                            => sub {
                                return << ".";

******************************** NOTE ********************************
***                                                                ***
***    The tests for this module were skipped during this build    ***
***                                                                ***
**********************************************************************

.
                            };
                            
use constant REPORT_MESSAGE_FOOTER
                            => sub {
                                return << ".";

******************************** NOTE ********************************
The comments above are created mechanically, possibly without manual
checking by the sender.  As there are many people performing automatic
tests on each upload to CPAN, it is likely that you will receive 
identical messages about the same problem.

If you believe that the message is mistaken, please reply to the first
one with correction and/or additional informations, and do not take
it personally.  We appreciate your patience. :)
**********************************************************************

Additional comments:
 
.
                             };

1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
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
4443dd53	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
6aaee015	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: