File Coverage

lib/CPANPLUS/Dist/MM.pm
Criterion Covered Total %
statement 266 386 68.9
branch 82 174 47.1
condition 29 62 46.7
subroutine 23 25 92.0
pod 6 7 85.7
total 406 654 62.0


line stmt bran cond sub pod time code
1             package CPANPLUS::Dist::MM;
2              
3 4     4   6237 use strict;
  4         8  
  4         154  
4 4     4   68 use warnings;
  4         10  
  4         149  
5 4     4   29 use vars qw[@ISA $STATUS $VERSION];
  4         18  
  4         268  
6 4     4   30 use base 'CPANPLUS::Dist::Base';
  4         9  
  4         796  
7             $VERSION = "0.9914";
8              
9 4     4   43 use CPANPLUS::Internals::Constants;
  4         18  
  4         2455  
10 4     4   48 use CPANPLUS::Internals::Constants::Report;
  4         11  
  4         839  
11 4     4   30 use CPANPLUS::Error;
  4         15  
  4         338  
12 4     4   31 use FileHandle;
  4         10  
  4         65  
13 4     4   2367 use Cwd;
  4         12  
  4         380  
14              
15 4     4   29 use IPC::Cmd qw[run];
  4         12  
  4         294  
16 4     4   36 use Params::Check qw[check];
  4         11  
  4         218  
17 4     4   26 use File::Basename qw[dirname];
  4         14  
  4         284  
18 4     4   29 use Module::Load::Conditional qw[can_load check_install];
  4         9  
  4         729  
19 4     4   35 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  4         11  
  4         38  
20              
21             local $Params::Check::VERBOSE = 1;
22              
23             =pod
24              
25             =head1 NAME
26              
27             CPANPLUS::Dist::MM - distribution class for MakeMaker related modules
28              
29             =head1 SYNOPSIS
30              
31             $mm = CPANPLUS::Dist::MM->new( module => $modobj );
32              
33             $mm->create; # runs make && make test
34             $mm->install; # runs make install
35              
36              
37             =head1 DESCRIPTION
38              
39             C is a distribution class for MakeMaker related
40             modules.
41             Using this package, you can create, install and uninstall perl
42             modules. It inherits from C.
43              
44             =head1 ACCESSORS
45              
46             =over 4
47              
48             =item parent()
49              
50             Returns the C object that parented this object.
51              
52             =item status()
53              
54             Returns the C object that keeps the status for
55             this module.
56              
57             =back
58              
59             =head1 STATUS ACCESSORS
60              
61             All accessors can be accessed as follows:
62             $mm->status->ACCESSOR
63              
64             =over 4
65              
66             =item makefile ()
67              
68             Location of the Makefile (or Build file).
69             Set to 0 explicitly if something went wrong.
70              
71             =item make ()
72              
73             BOOL indicating if the C (or C) command was successful.
74              
75             =item test ()
76              
77             BOOL indicating if the C (or C) command was
78             successful.
79              
80             =item prepared ()
81              
82             BOOL indicating if the C call exited successfully
83             This gets set after C
84              
85             =item distdir ()
86              
87             Full path to the directory in which the C call took place,
88             set after a call to C.
89              
90             =item created ()
91              
92             BOOL indicating if the C call exited successfully. This gets
93             set after C and C.
94              
95             =item installed ()
96              
97             BOOL indicating if the module was installed. This gets set after
98             C (or C) exits successfully.
99              
100             =item uninstalled ()
101              
102             BOOL indicating if the module was uninstalled properly.
103              
104             =item _create_args ()
105              
106             Storage of the arguments passed to C for this object. Used
107             for recursive calls when satisfying prerequisites.
108              
109             =item _install_args ()
110              
111             Storage of the arguments passed to C for this object. Used
112             for recursive calls when satisfying prerequisites.
113              
114             =back
115              
116             =cut
117              
118             =head1 METHODS
119              
120             =head2 $bool = $dist->format_available();
121              
122             Returns a boolean indicating whether or not you can use this package
123             to create and install modules in your environment.
124              
125             =cut
126              
127             ### check if the format is available ###
128             sub format_available {
129 15     15 1 85 my $dist = shift;
130              
131             ### we might be called as $class->format_available =/
132 15         141 require CPANPLUS::Internals;
133 15         141 my $cb = CPANPLUS::Internals->_retrieve_id(
134             CPANPLUS::Internals->_last_id );
135 15         77 my $conf = $cb->configure_object;
136              
137 15         95 my $mod = "ExtUtils::MakeMaker";
138 15 100       159 unless( can_load( modules => { $mod => 0.0 } ) ) {
139 1         8 error( loc( "You do not have '%1' -- '%2' not available",
140             $mod, __PACKAGE__ ) );
141 1         15 return;
142             }
143              
144 14         115260 for my $pgm ( qw[make] ) {
145 14 50       187 unless( $conf->get_program( $pgm ) ) {
146 0         0 error(loc(
147             "You do not have '%1' in your path -- '%2' not available\n" .
148             "Please check your config entry for '%1'",
149             $pgm, __PACKAGE__ , $pgm
150             ));
151 0         0 return;
152             }
153             }
154              
155 14         115 return 1;
156             }
157              
158             =pod
159              
160             =head2 $bool = $dist->init();
161              
162             Sets up the C object for use.
163             Effectively creates all the needed status accessors.
164              
165             Called automatically whenever you create a new C object.
166              
167             =cut
168              
169             sub init {
170 13     13 1 45 my $dist = shift;
171 13         98 my $status = $dist->status;
172              
173 13         1525 $status->mk_accessors(qw[makefile make test created installed uninstalled
174             bin_make _prepare_args _create_args _install_args _metadata]
175             );
176              
177 13         1415 return 1;
178             }
179              
180             =pod
181              
182             =head2 $bool = $dist->prepare([perl => '/path/to/perl', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
183              
184             C preps a distribution for installation. This means it will
185             run C and determine what prerequisites this distribution
186             declared.
187              
188             If you set C to true, it will go over all the stages of the
189             C process again, ignoring any previously cached results.
190              
191             When running C, the environment variable
192             C will be set to the full path of the
193             C that is being executed. This enables any code inside
194             the C to know that it is being installed via CPANPLUS.
195              
196             Returns true on success and false on failure.
197              
198             You may then call C<< $dist->create >> on the object to create the
199             installable files.
200              
201             =cut
202              
203             sub prepare {
204             ### just in case you already did a create call for this module object
205             ### just via a different dist object
206 13     13 1 8465 my $dist = shift;
207 13         117 my $self = $dist->parent;
208              
209             ### we're also the cpan_dist, since we don't need to have anything
210             ### prepared
211 13 100       1609 $dist = $self->status->dist_cpan if $self->status->dist_cpan;
212 13 100       1125 $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
213              
214 13         1057 my $cb = $self->parent;
215 13         710 my $conf = $cb->configure_object;
216 13         93 my %hash = @_;
217              
218 13         45 my $dir;
219 13 100       62 unless( $dir = $self->status->extract ) {
220 1         106 error( loc( "No dir found to operate on!" ) );
221 1         27 return;
222             }
223              
224 12         995 my $args;
225 12         39 my( $force, $verbose, $perl, $mmflags, $prereq_target, $prereq_format,
226             $prereq_build );
227 12         36 { local $Params::Check::ALLOW_UNKNOWN = 1;
  12         57  
228 12   50     131 my $tmpl = {
229             perl => { default => $^X, store => \$perl },
230             makemakerflags => { default =>
231             $conf->get_conf('makemakerflags') || '',
232             store => \$mmflags },
233             force => { default => $conf->get_conf('force'),
234             store => \$force },
235             verbose => { default => $conf->get_conf('verbose'),
236             store => \$verbose },
237             prereq_target => { default => '', store => \$prereq_target },
238             prereq_format => { default => '',
239             store => \$prereq_format },
240             prereq_build => { default => 0, store => \$prereq_build },
241             };
242              
243 12 50       96 $args = check( $tmpl, \%hash ) or return;
244             }
245              
246 12         2644 my @mmflags = $dist->_split_like_shell( $mmflags );
247              
248             ### maybe we already ran a create on this object? ###
249 12 100 100     328 return 1 if $dist->status->prepared && !$force;
250              
251             ### store the arguments, so ->install can use them in recursive loops ###
252 9         1826 $dist->status->_prepare_args( $args );
253              
254             ### chdir to work directory ###
255 9         70325 my $orig = cwd();
256 9 50       583 unless( $cb->_chdir( dir => $dir ) ) {
257 0         0 error( loc( "Could not chdir to build directory '%1'", $dir ) );
258 0         0 return;
259             }
260              
261 9         64 my $fail;
262             RUN: {
263              
264             ### we resolve 'configure requires' here, so we can run the 'perl
265             ### Makefile.PL' command
266             ### XXX for tests: mock f_c_r to something that *can* resolve and
267             ### something that *doesn't* resolve. Check the error log for ok
268             ### on this step or failure
269             ### XXX make a separate tarball to test for this scenario: simply
270             ### containing a makefile.pl/build.pl for test purposes?
271 9         37 { my $configure_requires = $dist->find_configure_requires;
  9         28  
  9         302  
272 9         184 my $ok = $dist->_resolve_prereqs(
273             format => $prereq_format,
274             verbose => $verbose,
275             prereqs => $configure_requires,
276             target => $prereq_target,
277             force => $force,
278             prereq_build => $prereq_build,
279             );
280              
281 9 50       148 unless( $ok ) {
282              
283             #### use $dist->flush to reset the cache ###
284 0         0 error( loc( "Unable to satisfy '%1' for '%2' " .
285             "-- aborting install",
286             'configure_requires', $self->module ) );
287 0         0 $dist->status->prepared(0);
288 0         0 $fail++;
289 0         0 last RUN;
290             }
291             ### end of prereq resolving ###
292             }
293              
294 9         174 my $metadata = $dist->status->_metadata;
295 9 50 33     2145 my $x_use_unsafe_inc = ( defined $metadata && exists $metadata->{x_use_unsafe_inc} ? $metadata->{x_use_unsafe_inc} : undef );
296 9 50       62 $x_use_unsafe_inc = 1 unless defined $x_use_unsafe_inc;
297              
298             local $ENV{PERL_USE_UNSAFE_INC} = $x_use_unsafe_inc
299 9 50       58 unless exists $ENV{PERL_USE_UNSAFE_INC};
300              
301             ### don't run 'perl makefile.pl' again if there's a makefile already
302 9 50 66     87 if( -e MAKEFILE->() && (-M MAKEFILE->() < -M $dir) && !$force ) {
      33        
303 0         0 msg(loc("'%1' already exists, not running '%2 %3' again ".
304             " unless you force",
305             MAKEFILE->(), $perl, MAKEFILE_PL->() ), $verbose );
306              
307             } else {
308 9 100       94 unless( -e MAKEFILE_PL->() ) {
309 3         35 msg(loc("No '%1' found - attempting to generate one",
310             MAKEFILE_PL->() ), $verbose );
311              
312 3         74 $dist->write_makefile_pl(
313             verbose => $verbose,
314             force => $force
315             );
316              
317             ### bail out if there's no makefile.pl ###
318 3 100       100 unless( -e MAKEFILE_PL->() ) {
319 1         29 error( loc( "Could not find '%1' - cannot continue",
320             MAKEFILE_PL->() ) );
321              
322             ### mark that we screwed up ###
323 1         29 $dist->status->makefile(0);
324 1         218 $fail++; last RUN;
  1         14  
325             }
326             }
327              
328             ### you can turn off running this verbose by changing
329             ### the config setting below, although it is really not
330             ### recommended
331 8   100     232 my $run_verbose = $verbose ||
332             $conf->get_conf('allow_build_interactivity') ||
333             0;
334              
335             ### this makes MakeMaker use defaults if possible, according
336             ### to schwern. See ticket 8047 for details.
337 8 100       152 local $ENV{PERL_MM_USE_DEFAULT} = 1 unless $run_verbose;
338              
339             ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
340             ### included in the makefile.pl -- it should build without
341             ### also, modules that run in taint mode break if we leave
342             ### our code ref in perl5opt
343             ### XXX we've removed the ENV settings from cp::inc, so only need
344             ### to reset the @INC
345             #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
346              
347             ### make sure it's a string, so that mmflags that have more than
348             ### one key value pair are passed as is, rather than as:
349             ### perl Makefile.PL "key=val key=>val"
350              
351              
352             #### XXX this needs to be the absolute path to the Makefile.PL
353             ### since cpanp-run-perl uses 'do' to execute the file, and do()
354             ### checks your @INC.. so, if there's _another_ makefile.pl in
355             ### your @INC, it will execute that one...
356 8         155 my $makefile_pl = MAKEFILE_PL->( $cb->_safe_path( path => $dir ) );
357              
358             ### setting autoflush to true fixes issue from rt #8047
359             ### XXX this means that we need to keep the path to CPANPLUS
360             ### in @INC, stopping us from resolving dependencies on CPANPLUS
361             ### at bootstrap time properly.
362              
363 8         100 my @run_perl = ( '-MCPANPLUS::Internals::Utils::Autoflush' );
364 8         76 my $cmd = [$perl, @run_perl, $makefile_pl, @mmflags];
365              
366             ### set ENV var to tell underlying code this is what we're
367             ### executing.
368 8         27 my $captured;
369 8         30 my $rv = do {
370 8         70 my $env = ENV_CPANPLUS_IS_EXECUTING;
371 8         144 local $ENV{$env} = $makefile_pl;
372 8         173 scalar run( command => $cmd,
373             buffer => \$captured,
374             verbose => $run_verbose, # may be interactive
375             );
376             };
377              
378 8 100       1695763 unless( $rv ) {
379 2         55 error( loc( "Could not run '%1 %2': %3 -- cannot continue",
380             $perl, MAKEFILE_PL->(), $captured ) );
381              
382 2         66 $dist->status->makefile(0);
383 2         593 $fail++; last RUN;
  2         75  
384             }
385              
386             ### put the output on the stack, don't print it
387 6         157 msg( $captured, 0 );
388             }
389              
390             ### so, nasty feature in Module::Build, that when a Makefile.PL
391             ### is a disguised Build.PL, it generates a Build file, not a
392             ### Makefile. this breaks everything :( see rt bug #19741
393 6 50 33     365 if( not -e MAKEFILE->( $dir ) and -e BUILD_PL->( $dir ) ) {
394 0         0 error(loc(
395             "We just ran '%1' without errors, but no '%2' is ".
396             "present. However, there is a '%3' file, so this may ".
397             "be related to bug #19741 in %4, which describes a ".
398             "fake '%5' which generates a '%6' file instead of a '%7'. ".
399             "You could try to work around this issue by setting '%8' ".
400             "to false and trying again. This will attempt to use the ".
401             "'%9' instead.",
402             "$^X ".MAKEFILE_PL->(), MAKEFILE->(), BUILD_PL->(),
403             'Module::Build', MAKEFILE_PL->(), 'Build', MAKEFILE->(),
404             'prefer_makefile', BUILD_PL->()
405             ));
406              
407 0         0 $fail++, last RUN;
408             }
409              
410             ### if we got here, we managed to make a 'makefile' ###
411 6         685 $dist->status->makefile( MAKEFILE->($dir) );
412              
413             ### Make (haha) sure that Makefile.PL is older than the Makefile
414             ### we just generated.
415 6         845 eval {
416 6         60 my $makestat = ( stat MAKEFILE->( $dir ) )[9];
417 6         164 my $mplstat = ( stat MAKEFILE_PL->( $cb->_safe_path( path => $dir ) ) )[9];
418 6 50       70 if ( $makestat < $mplstat ) {
419 0         0 my $ftime = $makestat - 60;
420 0         0 utime $ftime, $ftime, MAKEFILE_PL->( $cb->_safe_path( path => $dir ) );
421             }
422             };
423              
424             ### start resolving prereqs ###
425 6         122 my $prereqs = $self->status->prereqs;
426              
427             ### a hashref of prereqs on success, undef on failure ###
428 6   66     699 $prereqs ||= $dist->_find_prereqs(
429             verbose => $verbose,
430             file => $dist->status->makefile
431             );
432              
433 6 50       67 unless( $prereqs ) {
434 0         0 error( loc( "Unable to scan '%1' for prereqs",
435             $dist->status->makefile ) );
436              
437 0         0 $fail++; last RUN;
  0         0  
438             }
439             }
440              
441 9 50       180 unless( $cb->_chdir( dir => $orig ) ) {
442 0         0 error( loc( "Could not chdir back to start dir '%1'", $orig ) );
443             }
444              
445             ### save where we wrote this stuff -- same as extract dir in normal
446             ### installer circumstances
447 9         90 $dist->status->distdir( $self->status->extract );
448              
449 9 100       1617 return $dist->status->prepared( $fail ? 0 : 1);
450             }
451              
452             =pod
453              
454             =head2 $href = $dist->_find_prereqs( file => '/path/to/Makefile', [verbose => BOOL])
455              
456             Parses a C for C entries and distills from that
457             any prerequisites mentioned in the C
458              
459             Returns a hash with module-version pairs on success and false on
460             failure.
461              
462             =cut
463              
464             sub _find_prereqs {
465 3     3   711 my $dist = shift;
466 3         63 my $self = $dist->parent;
467 3         429 my $cb = $self->parent;
468 3         74 my $conf = $cb->configure_object;
469 3         46 my %hash = @_;
470              
471 3         36 my ($verbose, $file);
472 3         118 my $tmpl = {
473             verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
474             file => { required => 1, allow => FILE_READABLE, store => \$file },
475             };
476              
477 3 50       42 my $args = check( $tmpl, \%hash ) or return;
478              
479             ### see if we got prereqs from MYMETA
480 3         211 my $prereqs = $dist->find_mymeta_requires();
481              
482             ### we found some prereqs, we'll trust MYMETA
483             ### but we do need to run it through the callback
484 3 50       85 return $cb->_callbacks->filter_prereqs->( $cb, $prereqs ) if keys %$prereqs;
485              
486 0         0 my $fh = FileHandle->new();
487 0 0       0 unless( $fh->open( $file ) ) {
488 0         0 error( loc( "Cannot open '%1': %2", $file, $! ) );
489 0         0 return;
490             }
491              
492 0         0 my %p;
493 0         0 while( local $_ = <$fh> ) {
494 0         0 my ($found) = m|^[\#]\s+PREREQ_PM\s+=>\s+(.+)|;
495              
496 0 0       0 next unless $found;
497              
498 0         0 while( $found =~ m/(?:\s)([\w\:]+)=>(?:q\[(.*?)\],?|undef)/g ) {
499 0 0       0 if( defined $p{$1} ) {
500 0         0 my $ver = $cb->_version_to_number(version => $2);
501             $p{$1} = $ver
502 0 0       0 if $cb->_vcmp( $ver, $p{$1} ) > 0;
503             }
504             else {
505 0         0 $p{$1} = $cb->_version_to_number(version => $2);
506             }
507             }
508 0         0 last;
509             }
510              
511 0         0 my $href = $cb->_callbacks->filter_prereqs->( $cb, \%p );
512              
513 0         0 $self->status->prereqs( $href );
514              
515             ### just to make sure it's not the same reference ###
516 0         0 return { %$href };
517             }
518              
519             =pod
520              
521             =head2 $bool = $dist->create([perl => '/path/to/perl', make => '/path/to/make', makeflags => 'EXTRA=FLAGS', prereq_target => TARGET, skiptest => BOOL, force => BOOL, verbose => BOOL])
522              
523             C creates the files necessary for installation. This means
524             it will run C and C. This will also scan for and
525             attempt to satisfy any prerequisites the module may have.
526              
527             If you set C to true, it will skip the C stage.
528             If you set C to true, it will go over all the stages of the
529             C process again, ignoring any previously cached results. It
530             will also ignore a bad return value from C and still allow
531             the operation to return true.
532              
533             Returns true on success and false on failure.
534              
535             You may then call C<< $dist->install >> on the object to actually
536             install it.
537              
538             =cut
539              
540             sub create {
541             ### just in case you already did a create call for this module object
542             ### just via a different dist object
543 9     9 1 2086 my $dist = shift;
544 9         63 my $self = $dist->parent;
545              
546             ### we're also the cpan_dist, since we don't need to have anything
547             ### prepared
548 9 50       1019 $dist = $self->status->dist_cpan if $self->status->dist_cpan;
549 9 50       718 $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
550              
551 9         731 my $cb = $self->parent;
552 9         94 my $conf = $cb->configure_object;
553 9         45 my %hash = @_;
554              
555 9         20 my $dir;
556 9 50       54 unless( $dir = $self->status->extract ) {
557 0         0 error( loc( "No dir found to operate on!" ) );
558 0         0 return;
559             }
560              
561 9         812 my $args;
562 9         34 my( $force, $verbose, $make, $makeflags, $skiptest, $prereq_target, $perl,
563             @mmflags, $prereq_format, $prereq_build);
564 9         18 { local $Params::Check::ALLOW_UNKNOWN = 1;
  9         41  
565 9         165 my $tmpl = {
566             perl => { default => $^X, store => \$perl },
567             force => { default => $conf->get_conf('force'),
568             store => \$force },
569             verbose => { default => $conf->get_conf('verbose'),
570             store => \$verbose },
571             make => { default => $conf->get_program('make'),
572             store => \$make },
573             makeflags => { default => $conf->get_conf('makeflags'),
574             store => \$makeflags },
575             skiptest => { default => $conf->get_conf('skiptest'),
576             store => \$skiptest },
577             prereq_target => { default => '', store => \$prereq_target },
578             ### don't set the default prereq format to 'makemaker' -- wrong!
579             prereq_format => { #default => $self->status->installer_type,
580             default => '',
581             store => \$prereq_format },
582             prereq_build => { default => 0, store => \$prereq_build },
583             };
584              
585 9 50       97 $args = check( $tmpl, \%hash ) or return;
586             }
587              
588 9         2283 my @makeflags = $dist->_split_like_shell( $makeflags );
589              
590             ### maybe we already ran a create on this object?
591             ### make sure we add to include path again, just in case we came from
592             ### ->save_state, at which point we need to restore @INC/$PERL5LIB
593 9 100 100     87 if( $dist->status->created && !$force ) {
594 2         422 $self->add_to_includepath;
595 2         18 return 1;
596             }
597              
598             ### store the arguments, so ->install can use them in recursive loops ###
599 7         1369 $dist->status->_create_args( $args );
600              
601 7 100       1329 unless( $dist->status->prepared ) {
602 1         189 error( loc( "You have not successfully prepared a '%2' distribution ".
603             "yet -- cannot create yet", __PACKAGE__ ) );
604 1         26 return;
605             }
606              
607              
608             ### chdir to work directory ###
609 6         43686 my $orig = cwd();
610 6 100       355 unless( $cb->_chdir( dir => $dir ) ) {
611 1         470 error( loc( "Could not chdir to build directory '%1'", $dir ) );
612 1         65 return;
613             }
614              
615 5         61 my $fail; my $prereq_fail; my $test_fail;
  5         0  
616 5         33 my $status = { };
617             RUN: {
618              
619 5         93 my $metadata = $dist->status->_metadata;
  5         216  
620 5 50 33     2480 my $x_use_unsafe_inc = ( defined $metadata && exists $metadata->{x_use_unsafe_inc} ? $metadata->{x_use_unsafe_inc} : undef );
621 5 50       46 $x_use_unsafe_inc = 1 unless defined $x_use_unsafe_inc;
622              
623             local $ENV{PERL_USE_UNSAFE_INC} = $x_use_unsafe_inc
624 5 50       48 unless exists $ENV{PERL_USE_UNSAFE_INC};
625              
626             ### this will set the directory back to the start
627             ### dir, so we must chdir /again/
628 5         123 my $ok = $dist->_resolve_prereqs(
629             format => $prereq_format,
630             verbose => $verbose,
631             prereqs => $self->status->prereqs,
632             target => $prereq_target,
633             force => $force,
634             prereq_build => $prereq_build,
635             );
636              
637 5 50       84 unless( $cb->_chdir( dir => $dir ) ) {
638 0         0 error( loc( "Could not chdir to build directory '%1'", $dir ) );
639 0         0 return;
640             }
641              
642 5 50       52 unless( $ok ) {
643              
644             #### use $dist->flush to reset the cache ###
645 0         0 error( loc( "Unable to satisfy prerequisites for '%1' " .
646             "-- aborting install", $self->module ) );
647 0         0 $dist->status->make(0);
648 0         0 $fail++; $prereq_fail++;
  0         0  
649 0         0 last RUN;
650             }
651             ### end of prereq resolving ###
652              
653 5         34 my $captured;
654              
655             ### 'make' section ###
656 5 50 66     78 if( -d BLIB->($dir) && (-M BLIB->($dir) < -M $dir) && !$force ) {
      33        
657 0         0 msg(loc("Already ran '%1' for this module [%2] -- " .
658             "not running again unless you force",
659             $make, $self->module ), $verbose );
660             } else {
661 5 50       175 unless(scalar run( command => [$make, @makeflags],
662             buffer => \$captured,
663             verbose => $verbose )
664             ) {
665 0         0 error( loc( "MAKE failed: %1 %2", $!, $captured ) );
666 0 0       0 if ( $conf->get_conf('cpantest') ) {
667 0         0 $status->{stage} = 'build';
668 0         0 $status->{capture} = $captured;
669             }
670 0         0 $dist->status->make(0);
671 0         0 $fail++; last RUN;
  0         0  
672             }
673              
674             ### put the output on the stack, don't print it
675 5         2269667 msg( $captured, 0 );
676              
677 5         239 $dist->status->make(1);
678              
679             ### add this directory to your lib ###
680 5         2396 $self->add_to_includepath();
681              
682             ### don't bail out here, there's a conditional later on
683             #last RUN if $skiptest;
684             }
685              
686             ### 'make test' section ###
687 5 100       41 unless( $skiptest ) {
688              
689             ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
690             ### included in make test -- it should build without
691             ### also, modules that run in taint mode break if we leave
692             ### our code ref in perl5opt
693             ### XXX CPANPLUS::inc functionality is now obsolete.
694             #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
695              
696             ### you can turn off running this verbose by changing
697             ### the config setting below, although it is really not
698             ### recommended
699 4   50     178 my $run_verbose =
700             $verbose ||
701             $conf->get_conf('allow_build_interactivity') ||
702             0;
703              
704             ### XXX need to add makeflags here too?
705             ### yes, but they should really be split out -- see bug #4143
706 4         69 local $ENV{PERL_INSTALL_QUIET}; # shield tests from ExtUtils::Install
707 4 50       62 if( scalar run(
708             command => [$make, 'test', @makeflags],
709             buffer => \$captured,
710             verbose => $run_verbose,
711             ) ) {
712             ### tests might pass because it doesn't have any tests defined
713             ### log this occasion non-verbosely, so our test reporter can
714             ### pick up on this
715 4 50       133438 if ( NO_TESTS_DEFINED->( $captured ) ) {
716 0         0 msg( NO_TESTS_DEFINED->( $captured ), 0 )
717             } else {
718 4         102 msg( loc( "MAKE TEST passed: %1", $captured ), 0 );
719             }
720              
721 4 50       192 if ( $conf->get_conf('cpantest') ) {
722 0         0 $status->{stage} = 'test';
723 0         0 $status->{capture} = $captured;
724             }
725              
726 4         53 $dist->status->test(1);
727             } else {
728 0 0       0 error( loc( "MAKE TEST failed: %1", $captured ), ( $run_verbose ? 0 : 1 ) );
729              
730 0 0       0 if ( $conf->get_conf('cpantest') ) {
731 0         0 $status->{stage} = 'test';
732 0         0 $status->{capture} = $captured;
733             }
734              
735             ### send out error report here? or do so at a higher level?
736             ### --higher level --kane.
737 0         0 $dist->status->test(0);
738              
739             ### mark specifically *test* failure.. so we don't
740             ### send success on force...
741 0         0 $test_fail++;
742              
743 0 0 0     0 if( !$force and !$cb->_callbacks->proceed_on_test_failure->(
744             $self, $captured )
745             ) {
746 0         0 $fail++; last RUN;
  0         0  
747             }
748             }
749             }
750             } #
751              
752 5 50       1302 unless( $cb->_chdir( dir => $orig ) ) {
753 0         0 error( loc( "Could not chdir back to start dir '%1'", $orig ) );
754             }
755              
756             ### TODO: Add $stage to _send_report()
757             ### send out test report?
758             ### only do so if the failure is this module, not its prereq
759 5 50 33     99 if( $conf->get_conf('cpantest') and not $prereq_fail) {
760 0 0 0     0 $cb->_send_report(
761             module => $self,
762             failed => $test_fail || $fail,
763             buffer => CPANPLUS::Error->stack_as_string,
764             status => $status,
765             verbose => $verbose,
766             force => $force,
767             ) or error(loc("Failed to send test report for '%1'",
768             $self->module ) );
769             }
770              
771 5 50       65 return $dist->status->created( $fail ? 0 : 1);
772             }
773              
774             =pod
775              
776             =head2 $bool = $dist->install([make => '/path/to/make', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
777              
778             C runs the following command:
779             make install
780              
781             Returns true on success, false on failure.
782              
783             =cut
784              
785             sub install {
786              
787             ### just in case you did the create with ANOTHER dist object linked
788             ### to the same module object
789 1     1 1 19 my $dist = shift();
790 1         23 my $self = $dist->parent;
791 1 50       143 $dist = $self->status->dist_cpan if $self->status->dist_cpan;
792              
793 1         95 my $cb = $self->parent;
794 1         28 my $conf = $cb->configure_object;
795 1         9 my %hash = @_;
796              
797              
798 1 50       23 unless( $dist->status->created ) {
799 0         0 error(loc("You have not successfully created a '%2' distribution yet " .
800             "-- cannot install yet", __PACKAGE__ ));
801 0         0 return;
802             }
803              
804 1         185 my $dir;
805 1 50       23 unless( $dir = $self->status->extract ) {
806 0         0 error( loc( "No dir found to operate on!" ) );
807 0         0 return;
808             }
809              
810 1         104 my $args;
811 1         12 my($force,$verbose,$make,$makeflags);
812 1         10 { local $Params::Check::ALLOW_UNKNOWN = 1;
  1         13  
813 1         27 my $tmpl = {
814             force => { default => $conf->get_conf('force'),
815             store => \$force },
816             verbose => { default => $conf->get_conf('verbose'),
817             store => \$verbose },
818             make => { default => $conf->get_program('make'),
819             store => \$make },
820             makeflags => { default => $conf->get_conf('makeflags'),
821             store => \$makeflags },
822             };
823              
824 1 50       14 $args = check( $tmpl, \%hash ) or return;
825             }
826              
827             ### value set and false -- means failure ###
828 1 0 33     234 if( defined $self->status->installed &&
      33        
829             !$self->status->installed && !$force
830             ) {
831 0         0 error( loc( "Module '%1' has failed to install before this session " .
832             "-- aborting install", $self->module ) );
833 0         0 return;
834             }
835              
836 1         123 my @makeflags = $dist->_split_like_shell( $makeflags );
837              
838 1         14 $dist->status->_install_args( $args );
839              
840 1         6686 my $orig = cwd();
841 1 50       99 unless( $cb->_chdir( dir => $dir ) ) {
842 0         0 error( loc( "Could not chdir to build directory '%1'", $dir ) );
843 0         0 return;
844             }
845              
846 1         18 my $fail; my $captured;
847              
848 1         63 my $metadata = $dist->status->_metadata;
849 1 50 33     674 my $x_use_unsafe_inc = ( defined $metadata && exists $metadata->{x_use_unsafe_inc} ? $metadata->{x_use_unsafe_inc} : undef );
850 1 50       17 $x_use_unsafe_inc = 1 unless defined $x_use_unsafe_inc;
851              
852             local $ENV{PERL_USE_UNSAFE_INC} = $x_use_unsafe_inc
853 1 50       40 unless exists $ENV{PERL_USE_UNSAFE_INC};
854              
855             ### 'make install' section ###
856             ### XXX need makeflags here too?
857             ### yes, but they should really be split out.. see bug #4143
858 1         42 my $cmd = [$make, 'install', @makeflags];
859 1         55 my $sudo = $conf->get_program('sudo');
860 1 0 33     58 unshift @$cmd, $sudo if $sudo and $>;
861              
862 1         71 $cb->flush('lib');
863 1 50       43 unless(scalar run( command => $cmd,
864             verbose => $verbose,
865             buffer => \$captured,
866             ) ) {
867 0         0 error( loc( "MAKE INSTALL failed: %1 %2", $!, $captured ) );
868 0         0 $fail++;
869             }
870              
871             ### put the output on the stack, don't print it
872 1         175864 msg( $captured, 0 );
873              
874 1 50       42 unless( $cb->_chdir( dir => $orig ) ) {
875 0         0 error( loc( "Could not chdir back to start dir '%1'", $orig ) );
876             }
877              
878 1 50       46 return $dist->status->installed( $fail ? 0 : 1 );
879              
880             }
881              
882             =pod
883              
884             =head2 $bool = $dist->write_makefile_pl([force => BOOL, verbose => BOOL])
885              
886             This routine can write a C from the information in a
887             module object. It is used to write a C when the original
888             author forgot it (!!).
889              
890             Returns 1 on success and false on failure.
891              
892             The file gets written to the directory the module's been extracted
893             to.
894              
895             =cut
896              
897             sub write_makefile_pl {
898             ### just in case you already did a call for this module object
899             ### just via a different dist object
900 3     3 1 3665 my $dist = shift;
901 3         42 my $self = $dist->parent;
902 3 50       390 $dist = $self->status->dist_cpan if $self->status->dist_cpan;
903 3 50       271 $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
904              
905 3         308 my $cb = $self->parent;
906 3         40 my $conf = $cb->configure_object;
907 3         26 my %hash = @_;
908              
909 3         13 my $dir;
910 3 50       22 unless( $dir = $self->status->extract ) {
911 0         0 error( loc( "No dir found to operate on!" ) );
912 0         0 return;
913             }
914              
915 3         273 my ($force, $verbose);
916 3         26 my $tmpl = {
917             force => { default => $conf->get_conf('force'),
918             store => \$force },
919             verbose => { default => $conf->get_conf('verbose'),
920             store => \$verbose },
921             };
922              
923 3 50       24 my $args = check( $tmpl, \%hash ) or return;
924              
925 3         310 my $file = MAKEFILE_PL->($dir);
926 3 100 66     138 if( -s $file && !$force ) {
927 1         11 msg(loc("Already created '%1' - not doing so again without force",
928             $file ), $verbose );
929 1         28 return 1;
930             }
931              
932             ### due to a bug with AS perl 5.8.4 built 810 (and maybe others)
933             ### opening files with content in them already does nasty things;
934             ### seek to pos 0 and then print, but not truncating the file
935             ### bug reported to activestate on 19 sep 2004:
936             ### http://bugs.activestate.com/show_bug.cgi?id=34051
937 2 50       18 unlink $file if $force;
938              
939 2         33 my $fh = new FileHandle;
940 2 50       146 unless( $fh->open( ">$file" ) ) {
941 0         0 error( loc( "Could not create file '%1': %2", $file, $! ) );
942 0         0 return;
943             }
944              
945 2         203 my $mf = MAKEFILE_PL->();
946 2         25 my $name = $self->module;
947 2         18 my $version = $self->version;
948 2         53 my $author = $self->author->author;
949 2         9 my $href = $self->status->prereqs;
950             my $prereqs = join ",\n", map {
951 2         201 (' ' x 25) . "'$_'\t=> '$href->{$_}'"
  2         22  
952             } keys %$href;
953 2   50     9 $prereqs ||= ''; # just in case there are none;
954              
955 2         63 print $fh qq|
956             ### Auto-generated $mf by CPANPLUS ###
957              
958             use ExtUtils::MakeMaker;
959              
960             WriteMakefile(
961             NAME => '$name',
962             VERSION => '$version',
963             AUTHOR => '$author',
964             PREREQ_PM => {
965             $prereqs
966             },
967             );
968             \n|;
969              
970 2         37 $fh->close;
971 2         133 return 1;
972             }
973              
974             sub dist_dir {
975             ### just in case you already did a call for this module object
976             ### just via a different dist object
977 0     0 0 0 my $dist = shift;
978 0         0 my $self = $dist->parent;
979 0 0       0 $dist = $self->status->dist_cpan if $self->status->dist_cpan;
980 0 0       0 $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
981              
982 0         0 my $cb = $self->parent;
983 0         0 my $conf = $cb->configure_object;
984 0         0 my %hash = @_;
985              
986 0         0 my $make; my $verbose;
987 0         0 { local $Params::Check::ALLOW_UNKNOWN = 1;
  0         0  
988 0         0 my $tmpl = {
989             make => { default => $conf->get_program('make'),
990             store => \$make },
991             verbose => { default => $conf->get_conf('verbose'),
992             store => \$verbose },
993             };
994              
995 0 0       0 check( $tmpl, \%hash ) or return;
996             }
997              
998              
999 0         0 my $dir;
1000 0 0       0 unless( $dir = $self->status->extract ) {
1001 0         0 error( loc( "No dir found to operate on!" ) );
1002 0         0 return;
1003             }
1004              
1005             ### chdir to work directory ###
1006 0         0 my $orig = cwd();
1007 0 0       0 unless( $cb->_chdir( dir => $dir ) ) {
1008 0         0 error( loc( "Could not chdir to build directory '%1'", $dir ) );
1009 0         0 return;
1010             }
1011              
1012 0         0 my $fail; my $distdir;
1013             TRY: {
1014 0 0       0 $dist->prepare( @_ ) or (++$fail, last TRY);
  0         0  
1015              
1016              
1017 0         0 my $captured;
1018 0 0       0 unless(scalar run( command => [$make, 'distdir'],
1019             buffer => \$captured,
1020             verbose => $verbose )
1021             ) {
1022 0         0 error( loc( "MAKE DISTDIR failed: %1 %2", $!, $captured ) );
1023 0         0 ++$fail, last TRY;
1024             }
1025              
1026             ### /path/to/Foo-Bar-1.2/Foo-Bar-1.2
1027 0         0 $distdir = File::Spec->catdir( $dir, $self->package_name . '-' .
1028             $self->package_version );
1029              
1030 0 0       0 unless( -d $distdir ) {
1031 0         0 error(loc("Do not know where '%1' got created", 'distdir'));
1032 0         0 ++$fail, last TRY;
1033             }
1034             }
1035              
1036 0 0       0 unless( $cb->_chdir( dir => $orig ) ) {
1037 0         0 error( loc( "Could not chdir to start directory '%1'", $orig ) );
1038 0         0 return;
1039             }
1040              
1041 0 0       0 return if $fail;
1042 0         0 return $distdir;
1043             }
1044              
1045             sub _split_like_shell {
1046 22     22   152 my ($self, $string) = @_;
1047              
1048 22 50       109 return () unless defined($string);
1049 22 50       95 return @$string if ref $string eq 'ARRAY';
1050 22         77 $string =~ s/^\s+|\s+$//g;
1051 22 100       116 return () unless length($string);
1052              
1053 1         14 require Text::ParseWords;
1054 1         10 return Text::ParseWords::shellwords($self->_quote_literal($string));
1055             }
1056              
1057             sub _quote_literal {
1058 1     1   6 my ($self, $text) = @_;
1059 1         3 return $self->_quote_literal_vms($text) if ON_VMS;
1060 1         4 $text =~ s{'}{'\\''}g;
1061 1         9 $text =~ s{\$ (?!\() }{\$\$}gx;
1062 1         21 return "'$text'";
1063             }
1064              
1065             sub _quote_literal_vms {
1066 0     0     my ($self, $text) = @_;
1067 0           $text =~ s{"}{""}g;
1068 0           $text =~ s{\$ (?!\() }{"\$"}gx;
1069 0           return qq{"$text"};
1070             }
1071              
1072             1;
1073              
1074             # Local variables:
1075             # c-indentation-style: bsd
1076             # c-basic-offset: 4
1077             # indent-tabs-mode: nil
1078             # End:
1079             # vim: expandtab shiftwidth=4: