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