[p5sagit/p5-mst-13.2.git] / 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;


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

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

### 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
    }
);

If you are interested in making a more flexible Makefile.PL that can
probe for missing dependencies and install them, ExtUtils::AutoInstall
at <http://search.cpan.org/dist/ExtUtils-AutoInstall/> may be
worth a look.

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
	14
	15	$VERSION = 0.01;
	16	@ISA = qw[Exporter];
	17	@EXPORT = Package::Constants->list( __PACKAGE__ );
	18
	19	### for the version
	20	require CPANPLUS::Internals;
	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	If you are interested in making a more flexible Makefile.PL that can
235	probe for missing dependencies and install them, ExtUtils::AutoInstall
236	at <http://search.cpan.org/dist/ExtUtils-AutoInstall/> may be
237	worth a look.
238
239	Thanks! :-)
240
241	.
242	};
243
244	use constant REPORT_MISSING_TESTS
245	=> sub {
246	return << ".";
247	RECOMMENDATIONS:
248
249	It would be very helpful if you could include even a simple test
250	script in the next release, so people can verify which platforms
251	can successfully install them, as well as avoid regression bugs?
252
253	A simple 't/use.t' that says:
254
255	#!/usr/bin/env perl -w
256	use strict;
257	use Test;
258	BEGIN { plan tests => 1 }
259
260	use Your::Module::Here; ok(1);
261	exit;
262	__END__
263
264	would be appreciated. If you are interested in making a more robust
265	test suite, please see the Test::Simple, Test::More and Test::Tutorial
266	documentation at <http://search.cpan.org/dist/Test-Simple/>.
267
268	Thanks! :-)
269
270	.
271	};
272
273	use constant REPORT_LOADED_PREREQS
274	=> sub {
275	my $mod = shift;
276	my $cb = $mod->parent;
277	my $prq = $mod->status->prereqs \|\| {};
278
279	### not every prereq may be coming from CPAN
280	### so maybe we wont find it in our module
281	### tree at all...
282	### skip ones that cant be found in teh list
283	### as reported in #12723
284	my @prq = grep { defined }
285	map { $cb->module_tree($_) }
286	sort keys %$prq;
287
288	### no prereqs?
289	return '' unless @prq;
290
291	### some apparently, list what we loaded
292	my $str = << ".";
293	PREREQUISITES:
294
295	Here is a list of prerequisites you specified and versions we
296	managed to load:
297
298	.
299	$str .= join '',
622d31ac	300	map { sprintf "\t%s %-30s %8s %8s\n",
	301	@$_
	302
	303	} [' ', 'Module Name', 'Have', 'Want'],
	304	map { my $want = $prq->{$_->name};
	305	[ do { $_->is_uptodate(
6aaee015	306	version => $want
6aaee015	307	) ? ' ' : '!'
622d31ac	308	},
	309	$_->name,
	310	$_->installed_version,
	311	$want
	312	],
6aaee015	313	### might be empty entries in there
	314	} grep { defined $_ } @prq;
	315
	316	return $str;
	317	};
	318
	319	use constant REPORT_TESTS_SKIPPED
	320	=> sub {
	321	return << ".";
	322
	323	****************************** NOTE ******************************
	324	* *
	325	* The tests for this module were skipped during this build *
	326	* *
	327	**********************************************************************
	328
	329	.
	330	};
	331
	332	use constant REPORT_MESSAGE_FOOTER
	333	=> sub {
	334	return << ".";
	335
	336	****************************** NOTE ******************************
	337	The comments above are created mechanically, possibly without manual
	338	checking by the sender. As there are many people performing automatic
	339	tests on each upload to CPAN, it is likely that you will receive
	340	identical messages about the same problem.
	341
	342	If you believe that the message is mistaken, please reply to the first
	343	one with correction and/or additional informations, and do not take
	344	it personally. We appreciate your patience. :)
	345	**********************************************************************
	346
	347	Additional comments:
	348
	349	.
	350	};
	351
	352	1;
	353
	354	# Local variables:
	355	# c-indentation-style: bsd
	356	# c-basic-offset: 4
	357	# indent-tabs-mode: nil
	358	# End:
	359	# vim: expandtab shiftwidth=4: