This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
cd428691bcf5c90616766351cb539b0c394a1a12
[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[0] },
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
246     ### maybe we already ran a create on this object? ###
247     return 1 if $dist->status->prepared && !$force;
248
249     ### store the arguments, so ->install can use them in recursive loops ###
250     $dist->status->_prepare_args( $args );
251
252     ### chdir to work directory ###
253     my $orig = cwd();
254     unless( $cb->_chdir( dir => $dir ) ) {
255         error( loc( "Could not chdir to build directory '%1'", $dir ) );
256         return;
257     }
258
259     my $fail;
260     RUN: {
261
262         ### we resolve 'configure requires' here, so we can run the 'perl
263         ### Makefile.PL' command
264         ### XXX for tests: mock f_c_r to something that *can* resolve and
265         ### something that *doesn't* resolve. Check the error log for ok
266         ### on this step or failure
267         ### XXX make a separate tarball to test for this scenario: simply
268         ### containing a makefile.pl/build.pl for test purposes?
269         {   my $configure_requires = $dist->find_configure_requires;
270             my $ok = $dist->_resolve_prereqs(
271                             format          => $prereq_format,
272                             verbose         => $verbose,
273                             prereqs         => $configure_requires,
274                             target          => $prereq_target,
275                             force           => $force,
276                             prereq_build    => $prereq_build,
277                     );
278
279             unless( $ok ) {
280
281                 #### use $dist->flush to reset the cache ###
282                 error( loc( "Unable to satisfy '%1' for '%2' " .
283                             "-- aborting install",
284                             'configure_requires', $self->module ) );
285                 $dist->status->prepared(0);
286                 $fail++;
287                 last RUN;
288             }
289             ### end of prereq resolving ###
290         }
291
292
293
294         ### don't run 'perl makefile.pl' again if there's a makefile already
295         if( -e MAKEFILE->() && (-M MAKEFILE->() < -M $dir) && !$force ) {
296             msg(loc("'%1' already exists, not running '%2 %3' again ".
297                     " unless you force",
298                     MAKEFILE->(), $perl, MAKEFILE_PL->() ), $verbose );
299
300         } else {
301             unless( -e MAKEFILE_PL->() ) {
302                 msg(loc("No '%1' found - attempting to generate one",
303                         MAKEFILE_PL->() ), $verbose );
304
305                 $dist->write_makefile_pl(
306                             verbose => $verbose,
307                             force   => $force
308                         );
309
310                 ### bail out if there's no makefile.pl ###
311                 unless( -e MAKEFILE_PL->() ) {
312                     error( loc( "Could not find '%1' - cannot continue",
313                                 MAKEFILE_PL->() ) );
314
315                     ### mark that we screwed up ###
316                     $dist->status->makefile(0);
317                     $fail++; last RUN;
318                 }
319             }
320
321             ### you can turn off running this verbose by changing
322             ### the config setting below, although it is really not
323             ### recommended
324             my $run_verbose = $verbose ||
325                               $conf->get_conf('allow_build_interactivity') ||
326                               0;
327
328             ### this makes MakeMaker use defaults if possible, according
329             ### to schwern. See ticket 8047 for details.
330             local $ENV{PERL_MM_USE_DEFAULT} = 1 unless $run_verbose;
331
332             ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
333             ### included in the makefile.pl -- it should build without
334             ### also, modules that run in taint mode break if we leave
335             ### our code ref in perl5opt
336             ### XXX we've removed the ENV settings from cp::inc, so only need
337             ### to reset the @INC
338             #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
339
340             ### make sure it's a string, so that mmflags that have more than
341             ### one key value pair are passed as is, rather than as:
342             ### perl Makefile.PL "key=val key=>val"
343
344
345             #### XXX this needs to be the absolute path to the Makefile.PL
346             ### since cpanp-run-perl uses 'do' to execute the file, and do()
347             ### checks your @INC.. so, if there's _another_ makefile.pl in
348             ### your @INC, it will execute that one...
349             my $makefile_pl = MAKEFILE_PL->( $cb->_safe_path( path => $dir ) );
350
351             ### setting autoflush to true fixes issue from rt #8047
352             ### XXX this means that we need to keep the path to CPANPLUS
353             ### in @INC, stopping us from resolving dependencies on CPANPLUS
354             ### at bootstrap time properly.
355
356             my @run_perl    = ( '-e', PERL_WRAPPER );
357             my $cmd         = [$perl, @run_perl, $makefile_pl, @mmflags];
358
359             ### set ENV var to tell underlying code this is what we're
360             ### executing.
361             my $captured;
362             my $rv = do {
363                 my $env = ENV_CPANPLUS_IS_EXECUTING;
364                 local $ENV{$env} = $makefile_pl;
365                 scalar run( command => $cmd,
366                             buffer  => \$captured,
367                             verbose => $run_verbose, # may be interactive
368                         );
369             };
370
371             unless( $rv ) {
372                 error( loc( "Could not run '%1 %2': %3 -- cannot continue",
373                             $perl, MAKEFILE_PL->(), $captured ) );
374
375                 $dist->status->makefile(0);
376                 $fail++; last RUN;
377             }
378
379             ### put the output on the stack, don't print it
380             msg( $captured, 0 );
381         }
382
383         ### so, nasty feature in Module::Build, that when a Makefile.PL
384         ### is a disguised Build.PL, it generates a Build file, not a
385         ### Makefile. this breaks everything :( see rt bug #19741
386         if( not -e MAKEFILE->( $dir ) and -e BUILD_PL->( $dir ) ) {
387             error(loc(
388                     "We just ran '%1' without errors, but no '%2' is ".
389                     "present. However, there is a '%3' file, so this may ".
390                     "be related to bug #19741 in %4, which describes a ".
391                     "fake '%5' which generates a '%6' file instead of a '%7'. ".
392                     "You could try to work around this issue by setting '%8' ".
393                     "to false and trying again. This will attempt to use the ".
394                     "'%9' instead.",
395                     "$^X ".MAKEFILE_PL->(), MAKEFILE->(), BUILD_PL->(),
396                     'Module::Build', MAKEFILE_PL->(), 'Build', MAKEFILE->(),
397                     'prefer_makefile', BUILD_PL->()
398             ));
399
400             $fail++, last RUN;
401         }
402
403         ### if we got here, we managed to make a 'makefile' ###
404         $dist->status->makefile( MAKEFILE->($dir) );
405
406         ### Make (haha) sure that Makefile.PL is older than the Makefile
407         ### we just generated.
408         eval {
409           my $makestat = ( stat MAKEFILE->( $dir ) )[9];
410           my $mplstat = ( stat MAKEFILE_PL->( $cb->_safe_path( path => $dir ) ) )[9];
411           if ( $makestat < $mplstat ) {
412             my $ftime = $makestat - 60;
413             utime $ftime, $ftime, MAKEFILE_PL->( $cb->_safe_path( path => $dir ) );
414           }
415         };
416
417         ### start resolving prereqs ###
418         my $prereqs = $self->status->prereqs;
419
420         ### a hashref of prereqs on success, undef on failure ###
421         $prereqs    ||= $dist->_find_prereqs(
422                                     verbose => $verbose,
423                                     file    => $dist->status->makefile
424                                 );
425
426         unless( $prereqs ) {
427             error( loc( "Unable to scan '%1' for prereqs",
428                         $dist->status->makefile ) );
429
430             $fail++; last RUN;
431         }
432     }
433
434         unless( $cb->_chdir( dir => $orig ) ) {
435         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
436     }
437
438     ### save where we wrote this stuff -- same as extract dir in normal
439     ### installer circumstances
440     $dist->status->distdir( $self->status->extract );
441
442     return $dist->status->prepared( $fail ? 0 : 1);
443 }
444
445 =pod
446
447 =head2 $href = $dist->_find_prereqs( file => '/path/to/Makefile', [verbose => BOOL])
448
449 Parses a C<Makefile> for C<PREREQ_PM> entries and distills from that
450 any prerequisites mentioned in the C<Makefile>
451
452 Returns a hash with module-version pairs on success and false on
453 failure.
454
455 =cut
456
457 sub _find_prereqs {
458     my $dist = shift;
459     my $self = $dist->parent;
460     my $cb   = $self->parent;
461     my $conf = $cb->configure_object;
462     my %hash = @_;
463
464     my ($verbose, $file);
465     my $tmpl = {
466         verbose => { default => $conf->get_conf('verbose'), store => \$verbose },
467         file    => { required => 1, allow => FILE_READABLE, store => \$file },
468     };
469
470     my $args = check( $tmpl, \%hash ) or return;
471
472     ### see if we got prereqs from MYMETA
473     my $prereqs = $dist->find_mymeta_requires();
474
475     ### we found some prereqs, we'll trust MYMETA
476     ### but we do need to run it through the callback
477     return $cb->_callbacks->filter_prereqs->( $cb, $prereqs ) if keys %$prereqs;
478
479     my $fh = FileHandle->new();
480     unless( $fh->open( $file ) ) {
481         error( loc( "Cannot open '%1': %2", $file, $! ) );
482         return;
483     }
484
485     my %p;
486     while( local $_ = <$fh> ) {
487         my ($found) = m|^[\#]\s+PREREQ_PM\s+=>\s+(.+)|;
488
489         next unless $found;
490
491         while( $found =~ m/(?:\s)([\w\:]+)=>(?:q\[(.*?)\],?|undef)/g ) {
492             if( defined $p{$1} ) {
493                 my $ver = $cb->_version_to_number(version => $2);
494                 $p{$1} = $ver
495                   if $cb->_vcmp( $ver, $p{$1} ) > 0;
496             }
497             else {
498                 $p{$1} = $cb->_version_to_number(version => $2);
499             }
500         }
501         last;
502     }
503
504     my $href = $cb->_callbacks->filter_prereqs->( $cb, \%p );
505
506     $self->status->prereqs( $href );
507
508     ### just to make sure it's not the same reference ###
509     return { %$href };
510 }
511
512 =pod
513
514 =head2 $bool = $dist->create([perl => '/path/to/perl', make => '/path/to/make', makeflags => 'EXTRA=FLAGS', prereq_target => TARGET, skiptest => BOOL, force => BOOL, verbose => BOOL])
515
516 C<create> creates the files necessary for installation. This means
517 it will run C<make> and C<make test>.  This will also scan for and
518 attempt to satisfy any prerequisites the module may have.
519
520 If you set C<skiptest> to true, it will skip the C<make test> stage.
521 If you set C<force> to true, it will go over all the stages of the
522 C<make> process again, ignoring any previously cached results. It
523 will also ignore a bad return value from C<make test> and still allow
524 the operation to return true.
525
526 Returns true on success and false on failure.
527
528 You may then call C<< $dist->install >> on the object to actually
529 install it.
530
531 =cut
532
533 sub create {
534     ### just in case you already did a create call for this module object
535     ### just via a different dist object
536     my $dist = shift;
537     my $self = $dist->parent;
538
539     ### we're also the cpan_dist, since we don't need to have anything
540     ### prepared
541     $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
542     $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
543
544     my $cb   = $self->parent;
545     my $conf = $cb->configure_object;
546     my %hash = @_;
547
548     my $dir;
549     unless( $dir = $self->status->extract ) {
550         error( loc( "No dir found to operate on!" ) );
551         return;
552     }
553
554     my $args;
555     my( $force, $verbose, $make, $makeflags, $skiptest, $prereq_target, $perl,
556         @mmflags, $prereq_format, $prereq_build);
557     {   local $Params::Check::ALLOW_UNKNOWN = 1;
558         my $tmpl = {
559             perl            => {    default => $^X, store => \$perl },
560             force           => {    default => $conf->get_conf('force'),
561                                     store   => \$force },
562             verbose         => {    default => $conf->get_conf('verbose'),
563                                     store   => \$verbose },
564             make            => {    default => $conf->get_program('make'),
565                                     store   => \$make },
566             makeflags       => {    default => $conf->get_conf('makeflags'),
567                                     store   => \$makeflags },
568             skiptest        => {    default => $conf->get_conf('skiptest'),
569                                     store   => \$skiptest },
570             prereq_target   => {    default => '', store => \$prereq_target },
571             ### don't set the default prereq format to 'makemaker' -- wrong!
572             prereq_format   => {    #default => $self->status->installer_type,
573                                     default => '',
574                                     store   => \$prereq_format },
575             prereq_build    => {    default => 0, store => \$prereq_build },
576         };
577
578         $args = check( $tmpl, \%hash ) or return;
579     }
580
581     ### maybe we already ran a create on this object?
582     ### make sure we add to include path again, just in case we came from
583     ### ->save_state, at which point we need to restore @INC/$PERL5LIB
584     if( $dist->status->created && !$force ) {
585         $self->add_to_includepath;
586         return 1;
587     }
588
589     ### store the arguments, so ->install can use them in recursive loops ###
590     $dist->status->_create_args( $args );
591
592     unless( $dist->status->prepared ) {
593         error( loc( "You have not successfully prepared a '%2' distribution ".
594                     "yet -- cannot create yet", __PACKAGE__ ) );
595         return;
596     }
597
598
599     ### chdir to work directory ###
600     my $orig = cwd();
601     unless( $cb->_chdir( dir => $dir ) ) {
602         error( loc( "Could not chdir to build directory '%1'", $dir ) );
603         return;
604     }
605
606     my $fail; my $prereq_fail; my $test_fail;
607     my $status = { };
608     RUN: {
609         ### this will set the directory back to the start
610         ### dir, so we must chdir /again/
611         my $ok = $dist->_resolve_prereqs(
612                             format          => $prereq_format,
613                             verbose         => $verbose,
614                             prereqs         => $self->status->prereqs,
615                             target          => $prereq_target,
616                             force           => $force,
617                             prereq_build    => $prereq_build,
618                     );
619
620         unless( $cb->_chdir( dir => $dir ) ) {
621             error( loc( "Could not chdir to build directory '%1'", $dir ) );
622             return;
623         }
624
625         unless( $ok ) {
626
627             #### use $dist->flush to reset the cache ###
628             error( loc( "Unable to satisfy prerequisites for '%1' " .
629                         "-- aborting install", $self->module ) );
630             $dist->status->make(0);
631             $fail++; $prereq_fail++;
632             last RUN;
633         }
634         ### end of prereq resolving ###
635
636         my $captured;
637
638         ### 'make' section ###
639         if( -d BLIB->($dir) && (-M BLIB->($dir) < -M $dir) && !$force ) {
640             msg(loc("Already ran '%1' for this module [%2] -- " .
641                     "not running again unless you force",
642                     $make, $self->module ), $verbose );
643         } else {
644             unless(scalar run(  command => [$make, $makeflags],
645                                 buffer  => \$captured,
646                                 verbose => $verbose )
647             ) {
648                 error( loc( "MAKE failed: %1 %2", $!, $captured ) );
649                 if ( $conf->get_conf('cpantest') ) {
650                   $status->{stage} = 'build';
651                   $status->{capture} = $captured;
652                 }
653                 $dist->status->make(0);
654                 $fail++; last RUN;
655             }
656
657             ### put the output on the stack, don't print it
658             msg( $captured, 0 );
659
660             $dist->status->make(1);
661
662             ### add this directory to your lib ###
663             $self->add_to_includepath();
664
665             ### dont bail out here, there's a conditional later on
666             #last RUN if $skiptest;
667         }
668
669         ### 'make test' section ###
670         unless( $skiptest ) {
671
672             ### turn off our PERL5OPT so no modules from CPANPLUS::inc get
673             ### included in make test -- it should build without
674             ### also, modules that run in taint mode break if we leave
675             ### our code ref in perl5opt
676             ### XXX CPANPLUS::inc functionality is now obsolete.
677             #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || '';
678
679             ### you can turn off running this verbose by changing
680             ### the config setting below, although it is really not
681             ### recommended
682             my $run_verbose =
683                         $verbose ||
684                         $conf->get_conf('allow_build_interactivity') ||
685                         0;
686
687             ### XXX need to add makeflags here too?
688             ### yes, but they should really be split out -- see bug #4143
689             if( scalar run(
690                         command => [$make, 'test', $makeflags],
691                         buffer  => \$captured,
692                         verbose => $run_verbose,
693             ) ) {
694                 ### tests might pass because it doesn't have any tests defined
695                 ### log this occasion non-verbosely, so our test reporter can
696                 ### pick up on this
697                 if ( NO_TESTS_DEFINED->( $captured ) ) {
698                     msg( NO_TESTS_DEFINED->( $captured ), 0 )
699                 } else {
700                     msg( loc( "MAKE TEST passed: %1", $captured ), 0 );
701                 }
702
703                 if ( $conf->get_conf('cpantest') ) {
704                   $status->{stage} = 'test';
705                   $status->{capture} = $captured;
706                 }
707
708                 $dist->status->test(1);
709             } else {
710                 error( loc( "MAKE TEST failed: %1", $captured ), ( $run_verbose ? 0 : 1 ) );
711
712                 if ( $conf->get_conf('cpantest') ) {
713                   $status->{stage} = 'test';
714                   $status->{capture} = $captured;
715                 }
716
717                 ### send out error report here? or do so at a higher level?
718                 ### --higher level --kane.
719                 $dist->status->test(0);
720
721                 ### mark specifically *test* failure.. so we dont
722                 ### send success on force...
723                 $test_fail++;
724
725                 if( !$force and !$cb->_callbacks->proceed_on_test_failure->(
726                                       $self, $captured )
727                 ) {
728                     $fail++; last RUN;
729                 }
730             }
731         }
732     } #</RUN>
733
734     unless( $cb->_chdir( dir => $orig ) ) {
735         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
736     }
737
738     ### TODO: Add $stage to _send_report()
739     ### send out test report?
740     ### only do so if the failure is this module, not its prereq
741     if( $conf->get_conf('cpantest') and not $prereq_fail) {
742         $cb->_send_report(
743             module  => $self,
744             failed  => $test_fail || $fail,
745             buffer  => CPANPLUS::Error->stack_as_string,
746             status  => $status,
747             verbose => $verbose,
748             force   => $force,
749         ) or error(loc("Failed to send test report for '%1'",
750                     $self->module ) );
751     }
752
753     return $dist->status->created( $fail ? 0 : 1);
754 }
755
756 =pod
757
758 =head2 $bool = $dist->install([make => '/path/to/make',  makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL])
759
760 C<install> runs the following command:
761     make install
762
763 Returns true on success, false on failure.
764
765 =cut
766
767 sub install {
768
769     ### just in case you did the create with ANOTHER dist object linked
770     ### to the same module object
771     my $dist = shift();
772     my $self = $dist->parent;
773     $dist    = $self->status->dist_cpan if $self->status->dist_cpan;
774
775     my $cb   = $self->parent;
776     my $conf = $cb->configure_object;
777     my %hash = @_;
778
779
780     unless( $dist->status->created ) {
781         error(loc("You have not successfully created a '%2' distribution yet " .
782                   "-- cannot install yet", __PACKAGE__ ));
783         return;
784     }
785
786     my $dir;
787     unless( $dir = $self->status->extract ) {
788         error( loc( "No dir found to operate on!" ) );
789         return;
790     }
791
792     my $args;
793     my($force,$verbose,$make,$makeflags);
794     {   local $Params::Check::ALLOW_UNKNOWN = 1;
795         my $tmpl = {
796             force       => {    default => $conf->get_conf('force'),
797                                 store   => \$force },
798             verbose     => {    default => $conf->get_conf('verbose'),
799                                 store   => \$verbose },
800             make        => {    default => $conf->get_program('make'),
801                                 store   => \$make },
802             makeflags   => {    default => $conf->get_conf('makeflags'),
803                                 store   => \$makeflags },
804         };
805
806         $args = check( $tmpl, \%hash ) or return;
807     }
808
809     ### value set and false -- means failure ###
810     if( defined $self->status->installed &&
811         !$self->status->installed && !$force
812     ) {
813         error( loc( "Module '%1' has failed to install before this session " .
814                     "-- aborting install", $self->module ) );
815         return;
816     }
817
818
819     $dist->status->_install_args( $args );
820
821     my $orig = cwd();
822     unless( $cb->_chdir( dir => $dir ) ) {
823         error( loc( "Could not chdir to build directory '%1'", $dir ) );
824         return;
825     }
826
827     my $fail; my $captured;
828
829     ### 'make install' section ###
830     ### XXX need makeflags here too?
831     ### yes, but they should really be split out.. see bug #4143
832     my $cmd     = [$make, 'install', $makeflags];
833     my $sudo    = $conf->get_program('sudo');
834     unshift @$cmd, $sudo if $sudo and $>;
835
836     $cb->flush('lib');
837     unless(scalar run(  command => $cmd,
838                         verbose => $verbose,
839                         buffer  => \$captured,
840     ) ) {
841         error( loc( "MAKE INSTALL failed: %1 %2", $!, $captured ) );
842         $fail++;
843     }
844
845     ### put the output on the stack, don't print it
846     msg( $captured, 0 );
847
848     unless( $cb->_chdir( dir => $orig ) ) {
849         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
850     }
851
852     return $dist->status->installed( $fail ? 0 : 1 );
853
854 }
855
856 =pod
857
858 =head2 $bool = $dist->write_makefile_pl([force => BOOL, verbose => BOOL])
859
860 This routine can write a C<Makefile.PL> from the information in a
861 module object. It is used to write a C<Makefile.PL> when the original
862 author forgot it (!!).
863
864 Returns 1 on success and false on failure.
865
866 The file gets written to the directory the module's been extracted
867 to.
868
869 =cut
870
871 sub write_makefile_pl {
872     ### just in case you already did a call for this module object
873     ### just via a different dist object
874     my $dist = shift;
875     my $self = $dist->parent;
876     $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
877     $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
878
879     my $cb   = $self->parent;
880     my $conf = $cb->configure_object;
881     my %hash = @_;
882
883     my $dir;
884     unless( $dir = $self->status->extract ) {
885         error( loc( "No dir found to operate on!" ) );
886         return;
887     }
888
889     my ($force, $verbose);
890     my $tmpl = {
891         force           => {    default => $conf->get_conf('force'),
892                                 store => \$force },
893         verbose         => {    default => $conf->get_conf('verbose'),
894                                 store => \$verbose },
895     };
896
897     my $args = check( $tmpl, \%hash ) or return;
898
899     my $file = MAKEFILE_PL->($dir);
900     if( -s $file && !$force ) {
901         msg(loc("Already created '%1' - not doing so again without force",
902                 $file ), $verbose );
903         return 1;
904     }
905
906     ### due to a bug with AS perl 5.8.4 built 810 (and maybe others)
907     ### opening files with content in them already does nasty things;
908     ### seek to pos 0 and then print, but not truncating the file
909     ### bug reported to activestate on 19 sep 2004:
910     ### http://bugs.activestate.com/show_bug.cgi?id=34051
911     unlink $file if $force;
912
913     my $fh = new FileHandle;
914     unless( $fh->open( ">$file" ) ) {
915         error( loc( "Could not create file '%1': %2", $file, $! ) );
916         return;
917     }
918
919     my $mf      = MAKEFILE_PL->();
920     my $name    = $self->module;
921     my $version = $self->version;
922     my $author  = $self->author->author;
923     my $href    = $self->status->prereqs;
924     my $prereqs = join ",\n", map {
925                                 (' ' x 25) . "'$_'\t=> '$href->{$_}'"
926                             } keys %$href;
927     $prereqs ||= ''; # just in case there are none;
928
929     print $fh qq|
930     ### Auto-generated $mf by CPANPLUS ###
931
932     use ExtUtils::MakeMaker;
933
934     WriteMakefile(
935         NAME        => '$name',
936         VERSION     => '$version',
937         AUTHOR      => '$author',
938         PREREQ_PM   => {
939 $prereqs
940                     },
941     );
942     \n|;
943
944     $fh->close;
945     return 1;
946 }
947
948 sub dist_dir {
949     ### just in case you already did a call for this module object
950     ### just via a different dist object
951     my $dist = shift;
952     my $self = $dist->parent;
953     $dist    = $self->status->dist_cpan if      $self->status->dist_cpan;
954     $self->status->dist_cpan( $dist )   unless  $self->status->dist_cpan;
955
956     my $cb   = $self->parent;
957     my $conf = $cb->configure_object;
958     my %hash = @_;
959
960     my $make; my $verbose;
961     {   local $Params::Check::ALLOW_UNKNOWN = 1;
962         my $tmpl = {
963             make    => {    default => $conf->get_program('make'),
964                                     store => \$make },
965             verbose => {    default => $conf->get_conf('verbose'),
966                                     store   => \$verbose },
967         };
968
969         check( $tmpl, \%hash ) or return;
970     }
971
972
973     my $dir;
974     unless( $dir = $self->status->extract ) {
975         error( loc( "No dir found to operate on!" ) );
976         return;
977     }
978
979     ### chdir to work directory ###
980     my $orig = cwd();
981     unless( $cb->_chdir( dir => $dir ) ) {
982         error( loc( "Could not chdir to build directory '%1'", $dir ) );
983         return;
984     }
985
986     my $fail; my $distdir;
987     TRY: {
988         $dist->prepare( @_ ) or (++$fail, last TRY);
989
990
991         my $captured;
992             unless(scalar run(  command => [$make, 'distdir'],
993                             buffer  => \$captured,
994                             verbose => $verbose )
995         ) {
996             error( loc( "MAKE DISTDIR failed: %1 %2", $!, $captured ) );
997             ++$fail, last TRY;
998         }
999
1000         ### /path/to/Foo-Bar-1.2/Foo-Bar-1.2
1001         $distdir = File::Spec->catdir( $dir, $self->package_name . '-' .
1002                                                 $self->package_version );
1003
1004         unless( -d $distdir ) {
1005             error(loc("Do not know where '%1' got created", 'distdir'));
1006             ++$fail, last TRY;
1007         }
1008     }
1009
1010     unless( $cb->_chdir( dir => $orig ) ) {
1011         error( loc( "Could not chdir to start directory '%1'", $orig ) );
1012         return;
1013     }
1014
1015     return if $fail;
1016     return $distdir;
1017 }
1018
1019
1020 1;
1021
1022 # Local variables:
1023 # c-indentation-style: bsd
1024 # c-basic-offset: 4
1025 # indent-tabs-mode: nil
1026 # End:
1027 # vim: expandtab shiftwidth=4: