Commit | Line | Data |
6aaee015 |
1 | package CPANPLUS::Dist::MM; |
2 | |
3 | use strict; |
4 | use vars qw[@ISA $STATUS]; |
5 | @ISA = qw[CPANPLUS::Dist]; |
6 | |
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 | |
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 | |
40 | C<CPANPLUS::Dist::MM> is a distribution class for MakeMaker related |
41 | modules. |
42 | Using this package, you can create, install and uninstall perl |
43 | modules. It inherits from C<CPANPLUS::Dist>. |
44 | |
45 | =head1 ACCESSORS |
46 | |
47 | =over 4 |
48 | |
49 | =item parent() |
50 | |
51 | Returns the C<CPANPLUS::Module> object that parented this object. |
52 | |
53 | =item status() |
54 | |
55 | Returns the C<Object::Accessor> object that keeps the status for |
56 | this module. |
57 | |
58 | =back |
59 | |
60 | =head1 STATUS ACCESSORS |
61 | |
62 | All accessors can be accessed as follows: |
63 | $mm->status->ACCESSOR |
64 | |
65 | =over 4 |
66 | |
67 | =item makefile () |
68 | |
69 | Location of the Makefile (or Build file). |
70 | Set to 0 explicitly if something went wrong. |
71 | |
72 | =item make () |
73 | |
74 | BOOL indicating if the C<make> (or C<Build>) command was successful. |
75 | |
76 | =item test () |
77 | |
78 | BOOL indicating if the C<make test> (or C<Build test>) command was |
79 | successful. |
80 | |
81 | =item prepared () |
82 | |
83 | BOOL indicating if the C<prepare> call exited succesfully |
84 | This gets set after C<perl Makefile.PL> |
85 | |
86 | =item distdir () |
87 | |
88 | Full path to the directory in which the C<prepare> call took place, |
89 | set after a call to C<prepare>. |
90 | |
91 | =item created () |
92 | |
93 | BOOL indicating if the C<create> call exited succesfully. This gets |
94 | set after C<make> and C<make test>. |
95 | |
96 | =item installed () |
97 | |
98 | BOOL indicating if the module was installed. This gets set after |
99 | C<make install> (or C<Build install>) exits successfully. |
100 | |
101 | =item uninstalled () |
102 | |
103 | BOOL indicating if the module was uninstalled properly. |
104 | |
105 | =item _create_args () |
106 | |
107 | Storage of the arguments passed to C<create> for this object. Used |
108 | for recursive calls when satisfying prerequisites. |
109 | |
110 | =item _install_args () |
111 | |
112 | Storage of the arguments passed to C<install> for this object. Used |
113 | for recursive calls when satisfying prerequisites. |
114 | |
115 | =back |
116 | |
117 | =cut |
118 | |
119 | =head1 METHODS |
120 | |
121 | =head2 $bool = $dist->format_available(); |
122 | |
123 | Returns a boolean indicating whether or not you can use this package |
124 | to create and install modules in your environment. |
125 | |
126 | =cut |
127 | |
128 | ### check if the format is available ### |
129 | sub 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 | |
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 $bool = $dist->prepare([perl => '/path/to/perl', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) |
180 | |
181 | C<prepare> preps a distribution for installation. This means it will |
182 | run C<perl Makefile.PL> and determine what prerequisites this distribution |
183 | declared. |
184 | |
185 | If you set C<force> to true, it will go over all the stages of the |
186 | C<prepare> process again, ignoring any previously cached results. |
187 | |
188 | When running C<perl Makefile.PL>, the environment variable |
189 | C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the |
190 | C<Makefile.PL> that is being executed. This enables any code inside |
191 | the C<Makefile.PL> to know that it is being installed via CPANPLUS. |
192 | |
193 | Returns true on success and false on failure. |
194 | |
195 | You may then call C<< $dist->create >> on the object to create the |
196 | installable files. |
197 | |
198 | =cut |
199 | |
200 | sub 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 | |
409 | Parses a C<Makefile> for C<PREREQ_PM> entries and distills from that |
410 | any prerequisites mentioned in the C<Makefile> |
411 | |
412 | Returns a hash with module-version pairs on success and false on |
413 | failure. |
414 | |
415 | =cut |
416 | |
417 | sub _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 | |
467 | C<create> creates the files necessary for installation. This means |
468 | it will run C<make> and C<make test>. This will also scan for and |
469 | attempt to satisfy any prerequisites the module may have. |
470 | |
471 | If you set C<skiptest> to true, it will skip the C<make test> stage. |
472 | If you set C<force> to true, it will go over all the stages of the |
473 | C<make> process again, ignoring any previously cached results. It |
474 | will also ignore a bad return value from C<make test> and still allow |
475 | the operation to return true. |
476 | |
477 | Returns true on success and false on failure. |
478 | |
479 | You may then call C<< $dist->install >> on the object to actually |
480 | install it. |
481 | |
482 | =cut |
483 | |
484 | sub 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 | |
689 | C<install> runs the following command: |
690 | make install |
691 | |
692 | Returns true on success, false on failure. |
693 | |
694 | =cut |
695 | |
696 | sub 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 | |
789 | This routine can write a C<Makefile.PL> from the information in a |
790 | module object. It is used to write a C<Makefile.PL> when the original |
791 | author forgot it (!!). |
792 | |
793 | Returns 1 on success and false on failure. |
794 | |
795 | The file gets written to the directory the module's been extracted |
796 | to. |
797 | |
798 | =cut |
799 | |
800 | sub 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 | |
877 | sub 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 | |
949 | 1; |
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: |