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