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