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