Commit | Line | Data |
9b4bd854 |
1 | package CPANPLUS::Dist::Build; |
2 | |
3 | use strict; |
e83ba0bd |
4 | use warnings; |
9b4bd854 |
5 | use vars qw[@ISA $STATUS $VERSION]; |
6 | @ISA = qw[CPANPLUS::Dist]; |
7 | |
9b4bd854 |
8 | use CPANPLUS::Internals::Constants; |
9 | |
10 | ### these constants were exported by CPANPLUS::Internals::Constants |
11 | ### in previous versions.. they do the same though. If we want to have |
12 | ### a normal 'use' here, up the dependency to CPANPLUS 0.056 or higher |
13 | BEGIN { |
14 | require CPANPLUS::Dist::Build::Constants; |
15 | CPANPLUS::Dist::Build::Constants->import() |
16 | if not __PACKAGE__->can('BUILD') && __PACKAGE__->can('BUILD_DIR'); |
17 | } |
18 | |
19 | use CPANPLUS::Error; |
20 | |
21 | use Config; |
22 | use FileHandle; |
23 | use Cwd; |
e83ba0bd |
24 | use version; |
9b4bd854 |
25 | |
26 | use IPC::Cmd qw[run]; |
27 | use Params::Check qw[check]; |
28 | use Module::Load::Conditional qw[can_load check_install]; |
29 | use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; |
30 | |
31 | local $Params::Check::VERBOSE = 1; |
32 | |
329f7b8d |
33 | $VERSION = '0.30'; |
9b4bd854 |
34 | |
35 | =pod |
36 | |
37 | =head1 NAME |
38 | |
e83ba0bd |
39 | CPANPLUS::Dist::Build - CPANPLUS plugin to install packages that use Build.PL |
9b4bd854 |
40 | |
41 | =head1 SYNOPSIS |
42 | |
43 | my $build = CPANPLUS::Dist->new( |
44 | format => 'CPANPLUS::Dist::Build', |
45 | module => $modobj, |
46 | ); |
47 | |
e83ba0bd |
48 | $build->prepare; # runs Build.PL |
9b4bd854 |
49 | $build->create; # runs build && build test |
50 | $build->install; # runs build install |
51 | |
52 | |
53 | =head1 DESCRIPTION |
54 | |
55 | C<CPANPLUS::Dist::Build> is a distribution class for C<Module::Build> |
56 | related modules. |
57 | Using this package, you can create, install and uninstall perl |
58 | modules. It inherits from C<CPANPLUS::Dist>. |
59 | |
60 | Normal users won't have to worry about the interface to this module, |
61 | as it functions transparently as a plug-in to C<CPANPLUS> and will |
62 | just C<Do The Right Thing> when it's loaded. |
63 | |
64 | =head1 ACCESSORS |
65 | |
66 | =over 4 |
67 | |
e83ba0bd |
68 | =item C<parent()> |
9b4bd854 |
69 | |
70 | Returns the C<CPANPLUS::Module> object that parented this object. |
71 | |
e83ba0bd |
72 | =item C<status()> |
9b4bd854 |
73 | |
74 | Returns the C<Object::Accessor> object that keeps the status for |
75 | this module. |
76 | |
77 | =back |
78 | |
79 | =head1 STATUS ACCESSORS |
80 | |
81 | All accessors can be accessed as follows: |
82 | $build->status->ACCESSOR |
83 | |
84 | =over 4 |
85 | |
e83ba0bd |
86 | =item C<build_pl ()> |
9b4bd854 |
87 | |
88 | Location of the Build file. |
89 | Set to 0 explicitly if something went wrong. |
90 | |
e83ba0bd |
91 | =item C<build ()> |
9b4bd854 |
92 | |
93 | BOOL indicating if the C<Build> command was successful. |
94 | |
e83ba0bd |
95 | =item C<test ()> |
9b4bd854 |
96 | |
97 | BOOL indicating if the C<Build test> command was successful. |
98 | |
e83ba0bd |
99 | =item C<prepared ()> |
9b4bd854 |
100 | |
101 | BOOL indicating if the C<prepare> call exited succesfully |
102 | This gets set after C<perl Build.PL> |
103 | |
e83ba0bd |
104 | =item C<distdir ()> |
9b4bd854 |
105 | |
106 | Full path to the directory in which the C<prepare> call took place, |
107 | set after a call to C<prepare>. |
108 | |
e83ba0bd |
109 | =item C<created ()> |
9b4bd854 |
110 | |
111 | BOOL indicating if the C<create> call exited succesfully. This gets |
112 | set after C<Build> and C<Build test>. |
113 | |
e83ba0bd |
114 | =item C<installed ()> |
9b4bd854 |
115 | |
116 | BOOL indicating if the module was installed. This gets set after |
117 | C<Build install> exits successfully. |
118 | |
119 | =item uninstalled () |
120 | |
121 | BOOL indicating if the module was uninstalled properly. |
122 | |
e83ba0bd |
123 | =item C<_create_args ()> |
9b4bd854 |
124 | |
125 | Storage of the arguments passed to C<create> for this object. Used |
126 | for recursive calls when satisfying prerequisites. |
127 | |
e83ba0bd |
128 | =item C<_install_args ()> |
9b4bd854 |
129 | |
130 | Storage of the arguments passed to C<install> for this object. Used |
131 | for recursive calls when satisfying prerequisites. |
132 | |
9b4bd854 |
133 | =back |
134 | |
135 | =cut |
136 | |
9b4bd854 |
137 | =head1 METHODS |
138 | |
139 | =head2 $bool = CPANPLUS::Dist::Build->format_available(); |
140 | |
141 | Returns a boolean indicating whether or not you can use this package |
142 | to create and install modules in your environment. |
143 | |
144 | =cut |
145 | |
146 | ### check if the format is available ### |
147 | sub format_available { |
148 | my $mod = "Module::Build"; |
149 | unless( can_load( modules => { $mod => '0.2611' } ) ) { |
150 | error( loc( "You do not have '%1' -- '%2' not available", |
151 | $mod, __PACKAGE__ ) ); |
152 | return; |
153 | } |
154 | |
155 | return 1; |
156 | } |
157 | |
158 | |
159 | =head2 $bool = $dist->init(); |
160 | |
161 | Sets up the C<CPANPLUS::Dist::Build> 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[build_pl build test created installed uninstalled |
173 | _create_args _install_args _prepare_args |
174 | _mb_object _buildflags |
175 | ]); |
176 | |
177 | ### just in case 'format_available' didn't get called |
178 | require Module::Build; |
179 | |
180 | return 1; |
181 | } |
182 | |
183 | =pod |
184 | |
185 | =head2 $bool = $dist->prepare([perl => '/path/to/perl', buildflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) |
186 | |
e83ba0bd |
187 | C<prepare> prepares a distribution, running C<Build.PL> |
188 | and establishing any prerequisites this |
9b4bd854 |
189 | distribution has. |
190 | |
e83ba0bd |
191 | The variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path |
9b4bd854 |
192 | of the C<Build.PL> that is being executed. This enables any code inside |
193 | the C<Build.PL> to know that it is being installed via CPANPLUS. |
194 | |
195 | After a succcesfull C<prepare> you may call C<create> to create the |
196 | distribution, followed by C<install> to actually install it. |
197 | |
198 | Returns true on success and false on failure. |
199 | |
200 | =cut |
201 | |
202 | sub prepare { |
203 | ### just in case you already did a create call for this module object |
204 | ### just via a different dist object |
205 | my $dist = shift; |
206 | my $self = $dist->parent; |
207 | |
208 | ### we're also the cpan_dist, since we don't need to have anything |
209 | ### prepared from another installer |
210 | $dist = $self->status->dist_cpan if $self->status->dist_cpan; |
211 | $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; |
212 | |
213 | my $cb = $self->parent; |
214 | my $conf = $cb->configure_object; |
215 | my %hash = @_; |
216 | |
217 | my $dir; |
218 | unless( $dir = $self->status->extract ) { |
219 | error( loc( "No dir found to operate on!" ) ); |
220 | return; |
221 | } |
222 | |
223 | my $args; |
701602e6 |
224 | my( $force, $verbose, $buildflags, $perl, $prereq_target, $prereq_format, |
225 | $prereq_build ); |
9b4bd854 |
226 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
227 | my $tmpl = { |
228 | force => { default => $conf->get_conf('force'), |
229 | store => \$force }, |
230 | verbose => { default => $conf->get_conf('verbose'), |
231 | store => \$verbose }, |
232 | perl => { default => $^X, store => \$perl }, |
233 | buildflags => { default => $conf->get_conf('buildflags'), |
234 | store => \$buildflags }, |
701602e6 |
235 | prereq_target => { default => '', store => \$prereq_target }, |
236 | prereq_format => { default => '', |
237 | store => \$prereq_format }, |
238 | prereq_build => { default => 0, store => \$prereq_build }, |
9b4bd854 |
239 | }; |
240 | |
241 | $args = check( $tmpl, \%hash ) or return; |
242 | } |
243 | |
244 | return 1 if $dist->status->prepared && !$force; |
245 | |
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 | ### by now we've loaded module::build, and we're using the API, so |
256 | ### it's safe to remove CPANPLUS::inc from our inc path, especially |
257 | ### because it can trip up tests run under taint (just like EU::MM). |
258 | ### turn off our PERL5OPT so no modules from CPANPLUS::inc get |
259 | ### included in make test -- it should build without. |
260 | ### also, modules that run in taint mode break if we leave |
261 | ### our code ref in perl5opt |
262 | ### XXX we've removed the ENV settings from cp::inc, so only need |
263 | ### to reset the @INC |
264 | #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt; |
265 | #local $ENV{PERL5LIB} = CPANPLUS::inc->original_perl5lib; |
39a48622 |
266 | #local @INC = CPANPLUS::inc->original_inc; |
9b4bd854 |
267 | |
268 | ### this will generate warnings under anything lower than M::B 0.2606 |
baddfc47 |
269 | my @buildflags = $dist->_buildflags_as_list( $buildflags ); |
9b4bd854 |
270 | $dist->status->_buildflags( $buildflags ); |
271 | |
272 | my $fail; |
273 | RUN: { |
701602e6 |
274 | # 0.85_01 |
275 | ### we resolve 'configure requires' here, so we can run the 'perl |
276 | ### Makefile.PL' command |
277 | ### XXX for tests: mock f_c_r to something that *can* resolve and |
278 | ### something that *doesnt* resolve. Check the error log for ok |
279 | ### on this step or failure |
280 | ### XXX make a seperate tarball to test for this scenario: simply |
281 | ### containing a makefile.pl/build.pl for test purposes? |
282 | my $safe_ver = version->new('0.85_01'); |
283 | if ( version->new($CPANPLUS::Internals::VERSION) >= $safe_ver ) |
284 | { my $configure_requires = $dist->find_configure_requires; |
285 | my $ok = $dist->_resolve_prereqs( |
286 | format => $prereq_format, |
287 | verbose => $verbose, |
288 | prereqs => $configure_requires, |
289 | target => $prereq_target, |
290 | force => $force, |
291 | prereq_build => $prereq_build, |
292 | ); |
293 | |
294 | unless( $ok ) { |
295 | |
296 | #### use $dist->flush to reset the cache ### |
297 | error( loc( "Unable to satisfy '%1' for '%2' " . |
298 | "-- aborting install", |
299 | 'configure_requires', $self->module ) ); |
300 | $dist->status->prepared(0); |
301 | $fail++; |
302 | last RUN; |
303 | } |
304 | ### end of prereq resolving ### |
305 | } |
306 | |
9b4bd854 |
307 | # Wrap the exception that may be thrown here (should likely be |
308 | # done at a much higher level). |
e83ba0bd |
309 | my $prep_output; |
310 | |
311 | my $env = 'ENV_CPANPLUS_IS_EXECUTING'; |
312 | local $ENV{$env} = BUILD_PL->( $dir ); |
313 | |
baddfc47 |
314 | unless ( scalar run( command => [$perl, BUILD_PL->($dir), @buildflags], |
e83ba0bd |
315 | buffer => \$prep_output, |
316 | verbose => $verbose ) |
317 | ) { |
318 | error( loc( "Build.PL failed: %1", $prep_output ) ); |
9b4bd854 |
319 | $fail++; last RUN; |
320 | } |
321 | |
e83ba0bd |
322 | msg( $prep_output, 0 ); |
9b4bd854 |
323 | |
701602e6 |
324 | my $prereqs = $self->status->prereqs; |
325 | |
326 | $prereqs ||= $dist->_find_prereqs( verbose => $verbose, |
327 | dir => $dir, |
328 | perl => $perl, |
329 | buildflags => $buildflags ); |
9b4bd854 |
330 | |
331 | } |
332 | |
333 | ### send out test report? ### |
334 | if( $fail and $conf->get_conf('cpantest') ) { |
335 | $cb->_send_report( |
336 | module => $self, |
337 | failed => $fail, |
338 | buffer => CPANPLUS::Error->stack_as_string, |
339 | verbose => $verbose, |
340 | force => $force, |
341 | ) or error(loc("Failed to send test report for '%1'", |
342 | $self->module ) ); |
343 | } |
344 | |
345 | unless( $cb->_chdir( dir => $orig ) ) { |
346 | error( loc( "Could not chdir back to start dir '%1'", $orig ) ); |
347 | } |
348 | |
349 | ### save where we wrote this stuff -- same as extract dir in normal |
350 | ### installer circumstances |
351 | $dist->status->distdir( $self->status->extract ); |
352 | |
353 | return $dist->status->prepared( $fail ? 0 : 1 ); |
354 | } |
355 | |
356 | sub _find_prereqs { |
357 | my $dist = shift; |
9b4bd854 |
358 | my $self = $dist->parent; |
359 | my $cb = $self->parent; |
e83ba0bd |
360 | my $conf = $cb->configure_object; |
361 | my %hash = @_; |
362 | |
363 | my ($verbose, $dir, $buildflags, $perl); |
364 | my $tmpl = { |
365 | verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, |
366 | dir => { default => $self->status->extract, store => \$dir }, |
367 | perl => { default => $^X, store => \$perl }, |
368 | buildflags => { default => $conf->get_conf('buildflags'), |
369 | store => \$buildflags }, |
370 | }; |
371 | |
372 | my $args = check( $tmpl, \%hash ) or return; |
9b4bd854 |
373 | |
374 | my $prereqs = {}; |
e83ba0bd |
375 | |
376 | my $safe_ver = version->new('0.31_03'); |
377 | |
378 | my $content; |
379 | |
701602e6 |
380 | if ( version->new( $Module::Build::VERSION ) >= $safe_ver and ! ON_WIN32 ) { |
baddfc47 |
381 | my @buildflags = $dist->_buildflags_as_list( $buildflags ); |
382 | |
e83ba0bd |
383 | # Use the new Build action 'prereq_data' |
384 | |
baddfc47 |
385 | unless ( scalar run( command => [$perl, BUILD->($dir), 'prereq_data', @buildflags], |
e83ba0bd |
386 | buffer => \$content, |
387 | verbose => 0 ) |
388 | ) { |
389 | error( loc( "Build 'prereq_data' failed: %1 %2", $!, $content ) ); |
390 | return; |
391 | } |
392 | |
393 | } |
394 | else { |
395 | my $file = File::Spec->catfile( $dir, '_build', 'prereqs' ); |
396 | return unless -f $file; |
397 | |
398 | my $fh = FileHandle->new(); |
399 | |
400 | unless( $fh->open( $file ) ) { |
401 | error( loc( "Cannot open '%1': %2", $file, $! ) ); |
402 | return; |
403 | } |
404 | |
405 | $content = do { local $/; <$fh> }; |
406 | } |
407 | |
701602e6 |
408 | return unless $content; |
e83ba0bd |
409 | my $bphash = eval $content; |
410 | return unless $bphash and ref $bphash eq 'HASH'; |
9b4bd854 |
411 | foreach my $type ('requires', 'build_requires') { |
e83ba0bd |
412 | next unless $bphash->{$type} and ref $bphash->{$type} eq 'HASH'; |
413 | $prereqs->{$_} = $bphash->{$type}->{$_} for keys %{ $bphash->{$type} }; |
9b4bd854 |
414 | } |
415 | |
e83ba0bd |
416 | # Temporary fix |
417 | delete $prereqs->{'perl'}; |
418 | |
9b4bd854 |
419 | ### allows for a user defined callback to filter the prerequisite |
420 | ### list as they see fit, to remove (or add) any prereqs they see |
421 | ### fit. The default installed callback will return the hashref in |
422 | ### an unmodified form |
423 | ### this callback got added after cpanplus 0.0562, so use a 'can' |
424 | ### to find out if it's supported. For older versions, we'll just |
425 | ### return the hashref as is ourselves. |
426 | my $href = $cb->_callbacks->can('filter_prereqs') |
427 | ? $cb->_callbacks->filter_prereqs->( $cb, $prereqs ) |
428 | : $prereqs; |
429 | |
430 | $self->status->prereqs( $href ); |
431 | |
432 | ### make sure it's not the same ref |
433 | return { %$href }; |
434 | } |
435 | |
9b4bd854 |
436 | =pod |
437 | |
438 | =head2 $dist->create([perl => '/path/to/perl', buildflags => 'EXTRA=FLAGS', prereq_target => TARGET, force => BOOL, verbose => BOOL, skiptest => BOOL]) |
439 | |
440 | C<create> preps a distribution for installation. This means it will |
e83ba0bd |
441 | run C<Build> and C<Build test>. |
9b4bd854 |
442 | This will also satisfy any prerequisites the module may have. |
443 | |
444 | If you set C<skiptest> to true, it will skip the C<Build test> stage. |
445 | If you set C<force> to true, it will go over all the stages of the |
446 | C<Build> process again, ignoring any previously cached results. It |
447 | will also ignore a bad return value from C<Build test> and still allow |
448 | the operation to return true. |
449 | |
450 | Returns true on success and false on failure. |
451 | |
452 | You may then call C<< $dist->install >> on the object to actually |
453 | install it. |
454 | |
455 | =cut |
456 | |
457 | sub create { |
458 | ### just in case you already did a create call for this module object |
459 | ### just via a different dist object |
460 | my $dist = shift; |
461 | my $self = $dist->parent; |
462 | |
463 | ### we're also the cpan_dist, since we don't need to have anything |
464 | ### prepared from another installer |
465 | $dist = $self->status->dist_cpan if $self->status->dist_cpan; |
466 | $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; |
467 | |
468 | my $cb = $self->parent; |
469 | my $conf = $cb->configure_object; |
9b4bd854 |
470 | my %hash = @_; |
471 | |
472 | my $dir; |
473 | unless( $dir = $self->status->extract ) { |
474 | error( loc( "No dir found to operate on!" ) ); |
475 | return; |
476 | } |
477 | |
478 | my $args; |
479 | my( $force, $verbose, $buildflags, $skiptest, $prereq_target, |
480 | $perl, $prereq_format, $prereq_build); |
481 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
482 | my $tmpl = { |
483 | force => { default => $conf->get_conf('force'), |
484 | store => \$force }, |
485 | verbose => { default => $conf->get_conf('verbose'), |
486 | store => \$verbose }, |
487 | perl => { default => $^X, store => \$perl }, |
488 | buildflags => { default => $conf->get_conf('buildflags'), |
489 | store => \$buildflags }, |
490 | skiptest => { default => $conf->get_conf('skiptest'), |
491 | store => \$skiptest }, |
492 | prereq_target => { default => '', store => \$prereq_target }, |
493 | ### don't set the default format to 'build' -- that is wrong! |
494 | prereq_format => { #default => $self->status->installer_type, |
495 | default => '', |
496 | store => \$prereq_format }, |
497 | prereq_build => { default => 0, store => \$prereq_build }, |
498 | }; |
499 | |
500 | $args = check( $tmpl, \%hash ) or return; |
501 | } |
502 | |
89b75a3b |
503 | # restore the state as we have created this already. |
504 | if ( $dist->status->created && !$force ) { |
505 | ### add this directory to your lib ### |
506 | $self->add_to_includepath(); |
507 | return 1; |
508 | } |
9b4bd854 |
509 | |
510 | $dist->status->_create_args( $args ); |
511 | |
512 | ### is this dist prepared? |
513 | unless( $dist->status->prepared ) { |
514 | error( loc( "You have not successfully prepared a '%2' distribution ". |
515 | "yet -- cannot create yet", __PACKAGE__ ) ); |
516 | return; |
517 | } |
518 | |
519 | ### chdir to work directory ### |
520 | my $orig = cwd(); |
521 | unless( $cb->_chdir( dir => $dir ) ) { |
522 | error( loc( "Could not chdir to build directory '%1'", $dir ) ); |
523 | return; |
524 | } |
525 | |
526 | ### by now we've loaded module::build, and we're using the API, so |
527 | ### it's safe to remove CPANPLUS::inc from our inc path, especially |
528 | ### because it can trip up tests run under taint (just like EU::MM). |
529 | ### turn off our PERL5OPT so no modules from CPANPLUS::inc get |
530 | ### included in make test -- it should build without. |
531 | ### also, modules that run in taint mode break if we leave |
532 | ### our code ref in perl5opt |
533 | ### XXX we've removed the ENV settings from cp::inc, so only need |
534 | ### to reset the @INC |
535 | #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt; |
536 | #local $ENV{PERL5LIB} = CPANPLUS::inc->original_perl5lib; |
39a48622 |
537 | #local @INC = CPANPLUS::inc->original_inc; |
9b4bd854 |
538 | |
539 | ### but do it *before* the new_from_context, as M::B seems |
540 | ### to be actually running the file... |
541 | ### an unshift in the block seems to be ignored.. somehow... |
542 | #{ my $lib = $self->best_path_to_module_build; |
543 | # unshift @INC, $lib if $lib; |
544 | #} |
545 | unshift @INC, $self->best_path_to_module_build |
546 | if $self->best_path_to_module_build; |
547 | |
548 | ### this will generate warnings under anything lower than M::B 0.2606 |
baddfc47 |
549 | my @buildflags = $dist->_buildflags_as_list( $buildflags ); |
9b4bd854 |
550 | $dist->status->_buildflags( $buildflags ); |
551 | |
552 | my $fail; my $prereq_fail; my $test_fail; |
553 | RUN: { |
554 | |
555 | ### this will set the directory back to the start |
556 | ### dir, so we must chdir /again/ |
557 | my $ok = $dist->_resolve_prereqs( |
558 | force => $force, |
559 | format => $prereq_format, |
560 | verbose => $verbose, |
561 | prereqs => $self->status->prereqs, |
562 | target => $prereq_target, |
563 | prereq_build => $prereq_build, |
564 | ); |
565 | |
566 | unless( $cb->_chdir( dir => $dir ) ) { |
567 | error( loc( "Could not chdir to build directory '%1'", $dir ) ); |
568 | return; |
569 | } |
570 | |
571 | unless( $ok ) { |
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->build(0); |
576 | $fail++; $prereq_fail++; |
577 | last RUN; |
578 | } |
579 | |
e83ba0bd |
580 | my $captured; |
581 | |
baddfc47 |
582 | unless ( scalar run( command => [$perl, BUILD->($dir), @buildflags], |
e83ba0bd |
583 | buffer => \$captured, |
584 | verbose => $verbose ) |
585 | ) { |
586 | error( loc( "MAKE failed:\n%1", $captured ) ); |
9b4bd854 |
587 | $dist->status->build(0); |
588 | $fail++; last RUN; |
589 | } |
590 | |
e83ba0bd |
591 | msg( $captured, 0 ); |
592 | |
9b4bd854 |
593 | $dist->status->build(1); |
594 | |
595 | ### add this directory to your lib ### |
e83ba0bd |
596 | $self->add_to_includepath(); |
9b4bd854 |
597 | |
598 | ### this buffer will not include what tests failed due to a |
599 | ### M::B/Test::Harness bug. Reported as #9793 with patch |
600 | ### against 0.2607 on 26/1/2005 |
601 | unless( $skiptest ) { |
e83ba0bd |
602 | my $test_output; |
603 | my $flag = ON_VMS ? '"test"' : 'test'; |
baddfc47 |
604 | my $cmd = [$perl, BUILD->($dir), $flag, @buildflags]; |
e83ba0bd |
605 | unless ( scalar run( command => $cmd, |
606 | buffer => \$test_output, |
607 | verbose => $verbose ) |
608 | ) { |
609 | error( loc( "MAKE TEST failed:\n%1 ", $test_output ) ); |
9b4bd854 |
610 | |
611 | ### mark specifically *test* failure.. so we dont |
612 | ### send success on force... |
613 | $test_fail++; |
614 | |
078adea4 |
615 | if( !$force and !$cb->_callbacks->proceed_on_test_failure->( |
e83ba0bd |
616 | $self, $@ ) |
078adea4 |
617 | ) { |
e83ba0bd |
618 | $dist->status->test(0); |
619 | $fail++; last RUN; |
9b4bd854 |
620 | } |
e83ba0bd |
621 | |
622 | } |
623 | else { |
624 | msg( $test_output, 0 ); |
9b4bd854 |
625 | $dist->status->test(1); |
626 | } |
e83ba0bd |
627 | } |
628 | else { |
9b4bd854 |
629 | msg(loc("Tests skipped"), $verbose); |
e83ba0bd |
630 | } |
9b4bd854 |
631 | } |
632 | |
633 | unless( $cb->_chdir( dir => $orig ) ) { |
634 | error( loc( "Could not chdir back to start dir '%1'", $orig ) ); |
635 | } |
636 | |
637 | ### send out test report? ### |
638 | if( $conf->get_conf('cpantest') and not $prereq_fail ) { |
639 | $cb->_send_report( |
640 | module => $self, |
641 | failed => $test_fail || $fail, |
642 | buffer => CPANPLUS::Error->stack_as_string, |
643 | verbose => $verbose, |
644 | force => $force, |
645 | tests_skipped => $skiptest, |
646 | ) or error(loc("Failed to send test report for '%1'", |
647 | $self->module ) ); |
648 | } |
649 | |
650 | return $dist->status->created( $fail ? 0 : 1 ); |
651 | } |
652 | |
653 | =head2 $dist->install([verbose => BOOL, perl => /path/to/perl]) |
654 | |
655 | Actually installs the created dist. |
656 | |
657 | Returns true on success and false on failure. |
658 | |
659 | =cut |
660 | |
661 | sub install { |
662 | ### just in case you already did a create call for this module object |
663 | ### just via a different dist object |
664 | my $dist = shift; |
665 | my $self = $dist->parent; |
666 | |
667 | ### we're also the cpan_dist, since we don't need to have anything |
668 | ### prepared from another installer |
669 | $dist = $self->status->dist_cpan if $self->status->dist_cpan; |
9b4bd854 |
670 | |
671 | my $cb = $self->parent; |
672 | my $conf = $cb->configure_object; |
673 | my %hash = @_; |
674 | |
675 | |
676 | my $verbose; my $perl; my $force; |
677 | { local $Params::Check::ALLOW_UNKNOWN = 1; |
678 | my $tmpl = { |
679 | verbose => { default => $conf->get_conf('verbose'), |
680 | store => \$verbose }, |
681 | force => { default => $conf->get_conf('force'), |
682 | store => \$force }, |
683 | perl => { default => $^X, store => \$perl }, |
684 | }; |
685 | |
686 | my $args = check( $tmpl, \%hash ) or return; |
687 | $dist->status->_install_args( $args ); |
688 | } |
689 | |
690 | my $dir; |
691 | unless( $dir = $self->status->extract ) { |
692 | error( loc( "No dir found to operate on!" ) ); |
693 | return; |
694 | } |
695 | |
696 | my $orig = cwd(); |
697 | |
698 | unless( $cb->_chdir( dir => $dir ) ) { |
699 | error( loc( "Could not chdir to build directory '%1'", $dir ) ); |
700 | return; |
701 | } |
702 | |
703 | ### value set and false -- means failure ### |
704 | if( defined $self->status->installed && |
705 | !$self->status->installed && !$force |
706 | ) { |
707 | error( loc( "Module '%1' has failed to install before this session " . |
708 | "-- aborting install", $self->module ) ); |
709 | return; |
710 | } |
711 | |
712 | my $fail; |
baddfc47 |
713 | my @buildflags = $dist->_buildflags_as_list( $dist->status->_buildflags ); |
714 | |
9b4bd854 |
715 | ### hmm, how is this going to deal with sudo? |
716 | ### for now, check effective uid, if it's not root, |
717 | ### shell out, otherwise use the method |
718 | if( $> ) { |
719 | |
720 | ### don't worry about loading the right version of M::B anymore |
721 | ### the 'new_from_context' already added the 'right' path to |
722 | ### M::B at the top of the build.pl |
8431a0ba |
723 | ### On VMS, flags need to be quoted |
724 | my $flag = ON_VMS ? '"install"' : 'install'; |
baddfc47 |
725 | my $cmd = [$perl, BUILD->($dir), $flag, @buildflags]; |
9b4bd854 |
726 | my $sudo = $conf->get_program('sudo'); |
727 | unshift @$cmd, $sudo if $sudo; |
728 | |
729 | |
730 | my $buffer; |
731 | unless( scalar run( command => $cmd, |
732 | buffer => \$buffer, |
733 | verbose => $verbose ) |
734 | ) { |
735 | error(loc("Could not run '%1': %2", 'Build install', $buffer)); |
736 | $fail++; |
737 | } |
738 | } else { |
e83ba0bd |
739 | my $install_output; |
740 | my $flag = ON_VMS ? '"install"' : 'install'; |
baddfc47 |
741 | my $cmd = [$perl, BUILD->($dir), $flag, @buildflags]; |
e83ba0bd |
742 | unless( scalar run( command => $cmd, |
743 | buffer => \$install_output, |
744 | verbose => $verbose ) |
745 | ) { |
746 | error(loc("Could not run '%1': %2", 'Build install', $install_output)); |
9b4bd854 |
747 | $fail++; |
748 | } |
e83ba0bd |
749 | else { |
750 | msg( $install_output, 0 ); |
751 | } |
9b4bd854 |
752 | } |
753 | |
754 | |
755 | unless( $cb->_chdir( dir => $orig ) ) { |
756 | error( loc( "Could not chdir back to start dir '%1'", $orig ) ); |
757 | } |
758 | |
759 | return $dist->status->installed( $fail ? 0 : 1 ); |
760 | } |
761 | |
baddfc47 |
762 | ### returns the string 'foo=bar --zot quux' |
763 | ### as the list 'foo=bar', '--zot', 'qux' |
764 | sub _buildflags_as_list { |
9b4bd854 |
765 | my $self = shift; |
766 | my $flags = shift or return; |
767 | |
baddfc47 |
768 | return Module::Build->split_like_shell($flags); |
9b4bd854 |
769 | } |
770 | |
9b4bd854 |
771 | =head1 AUTHOR |
772 | |
773 | Originally by Jos Boumans E<lt>kane@cpan.orgE<gt>. Brought to working |
e83ba0bd |
774 | condition by Ken Williams E<lt>kwilliams@cpan.orgE<gt>. |
775 | |
4320d094 |
776 | Other hackery and currently maintained by Chris C<BinGOs> Williams ( no relation ). E<lt>bingos@cpan.orgE<gt>. |
9b4bd854 |
777 | |
e83ba0bd |
778 | =head1 LICENSE |
9b4bd854 |
779 | |
780 | The CPAN++ interface (of which this module is a part of) is |
781 | copyright (c) 2001, 2002, 2003, 2004, 2005 Jos Boumans E<lt>kane@cpan.orgE<gt>. |
782 | All rights reserved. |
783 | |
784 | This library is free software; |
785 | you may redistribute and/or modify it under the same |
786 | terms as Perl itself. |
787 | |
788 | =cut |
789 | |
790 | 1; |
791 | |
e83ba0bd |
792 | |
9b4bd854 |
793 | # Local variables: |
794 | # c-indentation-style: bsd |
795 | # c-basic-offset: 4 |
796 | # indent-tabs-mode: nil |
797 | # End: |
798 | # vim: expandtab shiftwidth=4: |
e83ba0bd |
799 | |