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