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