File Coverage

lib/CPANPLUS/Dist/Build.pm
Criterion Covered Total %
statement 176 274 64.2
branch 41 108 38.0
condition 11 29 37.9
subroutine 21 23 91.3
pod 6 7 85.7
total 255 441 57.8


line stmt bran cond sub pod time code
1             package CPANPLUS::Dist::Build;
2              
3 1     1   18 use strict;
  1         49  
  1         134  
4 1     1   50 use vars qw[@ISA $STATUS $VERSION];
  1         39  
  1         80  
5             @ISA = qw[CPANPLUS::Dist];
6              
7 1     1   2451 use CPANPLUS::inc;
  1         11  
  1         41  
8 1     1   18 use CPANPLUS::Internals::Constants;
  1         9  
  1         122  
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 1     1   38     require CPANPLUS::Dist::Build::Constants;
15 1 50 33     92     CPANPLUS::Dist::Build::Constants->import()
16                     if not __PACKAGE__->can('BUILD') && __PACKAGE__->can('BUILD_DIR');
17             }
18              
19 1     1   16 use CPANPLUS::Error;
  1         12  
  1         59  
20              
21 1     1   16 use Config;
  1         9  
  1         50  
22 1     1   15 use FileHandle;
  1         9  
  1         117  
23 1     1   24 use Cwd;
  1         9  
  1         59  
24              
25 1     1   16 use IPC::Cmd qw[run];
  1         9  
  1         58  
26 1     1   22 use Params::Check qw[check];
  1         10  
  1         63  
27 1     1   16 use Module::Load::Conditional qw[can_load check_install];
  1         9  
  1         75  
28 1     1   21 use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
  1         9  
  1         116  
29              
30             local $Params::Check::VERBOSE = 1;
31              
32             $VERSION = '0.05';
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 8     8 1 4576     my $mod = "Module::Build";
153 8 50       339     unless( can_load( modules => { $mod => '0.2611' } ) ) {
154 0         0         error( loc( "You do not have '%1' -- '%2' not available",
155                                 $mod, __PACKAGE__ ) );
156 0         0         return;
157                 }
158              
159 8         891     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 7     7 1 409     my $dist = shift;
174 7         81     my $status = $dist->status;
175              
176 7         514     $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 7         223     require Module::Build;
183              
184 7         94     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 7     7 1 875     my $dist = shift;
211 7         206     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 7 50       187     $dist = $self->status->dist_cpan if $self->status->dist_cpan;
216 7 50       808     $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
217              
218 7         344     my $cb = $self->parent;
219 7         423     my $conf = $cb->configure_object;
220 7         247     my %hash = @_;
221              
222 7         84     my $dir;
223 7 50       83     unless( $dir = $self->status->extract ) {
224 0         0         error( loc( "No dir found to operate on!" ) );
225 0         0         return;
226                 }
227              
228 7         305     my $args;
229 7         59     my( $force, $verbose, $buildflags, $perl);
230 7         62     { local $Params::Check::ALLOW_UNKNOWN = 1;
  7         63  
231 7         126         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 7 50       879         $args = check( $tmpl, \%hash ) or return;
242                 }
243              
244 7 50 33     105     return 1 if $dist->status->prepared && !$force;
245              
246 7         234     $dist->status->_prepare_args( $args );
247              
248             ### chdir to work directory ###
249 7         334     my $orig = cwd();
250 7 50       203860     unless( $cb->_chdir( dir => $dir ) ) {
251 0         0         error( loc( "Could not chdir to build directory '%1'", $dir ) );
252 0         0         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 7         1517     local @INC = CPANPLUS::inc->original_inc;
267              
268             ### this will generate warnings under anything lower than M::B 0.2606
269 7         643     my %buildflags = $dist->_buildflags_as_hash( $buildflags );
270 7         776     $dist->status->_buildflags( $buildflags );
271              
272 7         951     my $fail;
273                 RUN: {
274             # Wrap the exception that may be thrown here (should likely be
275             # done at a much higher level).
276 7         64         my $mb = eval {
  7         199  
277 7         146             my $env = 'ENV_CPANPLUS_IS_EXECUTING';
278 7         435             local $ENV{$env} = BUILD_PL->( $dir );
279 7         753             Module::Build->new_from_context( %buildflags )
280                     };
281 7 100 66     626         if( !$mb or $@ ) {
282 1         294             error(loc("Could not create Module::Build object: %1","$@"));
283 1         718             $fail++; last RUN;
  1         25  
284                     }
285              
286 6         1139         $dist->status->_mb_object( $mb );
287              
288 6         2133         $self->status->prereqs( $dist->_find_prereqs( verbose => $verbose ) );
289              
290                 }
291                 
292             ### send out test report? ###
293 7 50 66     293     if( $fail and $conf->get_conf('cpantest') ) {
294 0 0       0            $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 7 50       1071     unless( $cb->_chdir( dir => $orig ) ) {
305 0         0         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 7         373     $dist->status->distdir( $self->status->extract );
311              
312 7 100       108     return $dist->status->prepared( $fail ? 0 : 1 );
313             }
314              
315             sub _find_prereqs {
316 6     6   1137     my $dist = shift;
317 6         76     my $mb = $dist->status->_mb_object;
318 6         674     my $self = $dist->parent;
319 6         441     my $cb = $self->parent;
320              
321 6         2189     my $prereqs = {};
322 6         195     foreach my $type ('requires', 'build_requires') {
323 12   50     336       my $p = $mb->$type() || {};
324 12         104       $prereqs->{$_} = $p->{$_} foreach keys %$p;
  12         2304  
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 6 50       471     my $href = $cb->_callbacks->can('filter_prereqs')
335                                 ? $cb->_callbacks->filter_prereqs->( $cb, $prereqs )
336                                 : $prereqs;
337              
338 6         3663     $self->status->prereqs( $href );
339              
340             ### make sure it's not the same ref
341 6         743     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 0     0 1 0   my ($dist, %args) = @_;
350 0         0   my $mb = $dist->status->_mb_object;
351 0         0   my $cb = $dist->parent->parent;
352 0         0   my $mod = $args{modobj}->module;
353               
354 0         0   my $status = $mb->check_installed_status($mod, $args{version});
355 0 0       0   return 1 if $status->{ok};
356               
357             # Check the latest version from the CPAN index
358               {
359 1     1   26     no strict 'refs';
  1         10  
  1         18  
  0         0  
360 0         0     local ${$mod . '::VERSION'} = $args{modobj}->version;
  0         0  
361 0         0     $status = $mb->check_installed_status($mod, $args{version});
362               }
363 0 0       0   unless( $status->{ok} ) {
364 0         0     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 0         0   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 4     4 1 333     my $dist = shift;
397 4         124     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 4 50       206     $dist = $self->status->dist_cpan if $self->status->dist_cpan;
402 4 50       288     $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan;
403              
404 4         59     my $cb = $self->parent;
405 4         586     my $conf = $cb->configure_object;
406 4         205     my $mb = $dist->status->_mb_object;
407 4         91     my %hash = @_;
408              
409 4         54     my $dir;
410 4 50       71     unless( $dir = $self->status->extract ) {
411 0         0         error( loc( "No dir found to operate on!" ) );
412 0         0         return;
413                 }
414              
415 4         72     my $args;
416 4         62     my( $force, $verbose, $buildflags, $skiptest, $prereq_target,
417                     $perl, $prereq_format, $prereq_build);
418 4         90     { local $Params::Check::ALLOW_UNKNOWN = 1;
  4         128  
419 4         116         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 4 50       628         $args = check( $tmpl, \%hash ) or return;
438                 }
439              
440 4 50 33     116     return 1 if $dist->status->created && !$force;
441              
442 4         50     $dist->status->_create_args( $args );
443              
444             ### is this dist prepared?
445 4 50       84     unless( $dist->status->prepared ) {
446 0         0         error( loc( "You have not successfully prepared a '%2' distribution ".
447                                 "yet -- cannot create yet", __PACKAGE__ ) );
448 0         0         return;
449                 }
450              
451             ### chdir to work directory ###
452 4         507     my $orig = cwd();
453 4 50       153806     unless( $cb->_chdir( dir => $dir ) ) {
454 0         0         error( loc( "Could not chdir to build directory '%1'", $dir ) );
455 0         0         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 4         1007     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 4 50       702     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 4         603     my %buildflags = $dist->_buildflags_as_hash( $buildflags );
482 4         512     $dist->status->_buildflags( $buildflags );
483              
484 4         38     my $fail; my $prereq_fail; my $test_fail;
  4         72  
  4         84  
485 4         392     RUN: {
486              
487             ### this will set the directory back to the start
488             ### dir, so we must chdir /again/
489 4         53         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 4 50       1023         unless( $cb->_chdir( dir => $dir ) ) {
499 0         0             error( loc( "Could not chdir to build directory '%1'", $dir ) );
500 0         0             return;
501                     }
502              
503 4 50       335         unless( $ok ) {
504             #### use $dist->flush to reset the cache ###
505 0         0             error( loc( "Unable to satisfy prerequisites for '%1' " .
506                                     "-- aborting install", $self->module ) );
507 0         0             $dist->status->build(0);
508 0         0             $fail++; $prereq_fail++;
  0         0  
509 0         0             last RUN;
510                     }
511              
512 4         117         eval { $mb->dispatch('build', %buildflags) };
  4         366  
513 4 50       4249         if( $@ ) {
514 0         0             error(loc("Could not run '%1': %2", 'Build', "$@"));
515 0         0             $dist->status->build(0);
516 0         0             $fail++; last RUN;
  0         0  
517                     }
518              
519 4         227         $dist->status->build(1);
520              
521             ### add this directory to your lib ###
522 4         296         $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 0 0       0         unless( $skiptest ) {
530 0         0             eval { $mb->dispatch('test', %buildflags) };
  4         659  
531 0 0       0             if( $@ ) {
532 0         0                 error(loc("Could not run '%1': %2", 'Build test', "$@"));
533              
534             ### mark specifically *test* failure.. so we dont
535             ### send success on force...
536 0         0                 $test_fail++;
537              
538 0 0       0                 unless($force) {
539 0         0                     $dist->status->test(0);
540 0         0                     $fail++; last RUN;
  0         0  
541                             }
542                         } else {
543 0         0                 $dist->status->test(1);
544                         }
545                     } else {
546 0         0             msg(loc("Tests skipped"), $verbose);
547                     }
548                 }
549              
550 0 0       0     unless( $cb->_chdir( dir => $orig ) ) {
551 4         300         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
552                 }
553              
554             ### send out test report? ###
555 4 50 33     1714     if( $conf->get_conf('cpantest') and not $prereq_fail ) {
556 0 50 0     0         $cb->_send_report(
557                         module => $self,
558                         failed => $test_fail || $fail,
559                         buffer => CPANPLUS::Error->stack_as_string,
560                         verbose => $verbose,
561                         force => $force,
562                         tests_skipped => $skiptest,
563                     ) or error(loc("Failed to send test report for '%1'",
564                                 $self->module ) );
565                 }
566              
567 4 0       355     return $dist->status->created( $fail ? 0 : 1 );
568             }
569              
570             =head2 $dist->install([verbose => BOOL, perl => /path/to/perl])
571            
572             Actually installs the created dist.
573            
574             Returns true on success and false on failure.
575            
576             =cut
577              
578             sub install {
579             ### just in case you already did a create call for this module object
580             ### just via a different dist object
581 0     2 1 0     my $dist = shift;
582 4         137     my $self = $dist->parent;
583              
584             ### we're also the cpan_dist, since we don't need to have anything
585             ### prepared from another installer
586 2 50       592     $dist = $self->status->dist_cpan if $self->status->dist_cpan;
587 2         78     my $mb = $dist->status->_mb_object;
588              
589 2         105     my $cb = $self->parent;
590 2         30     my $conf = $cb->configure_object;
591 2         102     my %hash = @_;
592              
593                 
594 2         135     my $verbose; my $perl; my $force;
  2         123  
  2         19  
595 2         37     { local $Params::Check::ALLOW_UNKNOWN = 1;
  2         18  
596 2         18         my $tmpl = {
597                         verbose => { default => $conf->get_conf('verbose'),
598                                      store => \$verbose },
599                         force => { default => $conf->get_conf('force'),
600                                      store => \$force },
601                         perl => { default => $^X, store => \$perl },
602                     };
603                 
604 2 50       78         my $args = check( $tmpl, \%hash ) or return;
605 2         35         $dist->status->_install_args( $args );
606                 }
607              
608 2         100     my $dir;
609 2 50       33     unless( $dir = $self->status->extract ) {
610 2         20         error( loc( "No dir found to operate on!" ) );
611 2         31         return;
612                 }
613              
614 0         0     my $orig = cwd();
615              
616 0 50       0     unless( $cb->_chdir( dir => $dir ) ) {
617 2         31         error( loc( "Could not chdir to build directory '%1'", $dir ) );
618 2         69849         return;
619                 }
620              
621             ### value set and false -- means failure ###
622 0 50 33     0     if( defined $self->status->installed &&
      33        
623                     !$self->status->installed && !$force
624                 ) {
625 0         0         error( loc( "Module '%1' has failed to install before this session " .
626                                 "-- aborting install", $self->module ) );
627 2         360         return;
628                 }
629              
630 0         0     my $fail;
631 0         0     my $buildflags = $dist->status->_buildflags;
632             ### hmm, how is this going to deal with sudo?
633             ### for now, check effective uid, if it's not root,
634             ### shell out, otherwise use the method
635 2 50       72     if( $> ) {
636              
637             ### don't worry about loading the right version of M::B anymore
638             ### the 'new_from_context' already added the 'right' path to
639             ### M::B at the top of the build.pl
640 2         226         my $cmd = [$perl, BUILD->($dir), 'install', $buildflags];
641 2         127         my $sudo = $conf->get_program('sudo');
642 2 50       222         unshift @$cmd, $sudo if $sudo;
643              
644              
645 2         606         my $buffer;
646 2 50       130         unless( scalar run( command => $cmd,
647                                         buffer => \$buffer,
648                                         verbose => $verbose )
649                     ) {
650 2         34             error(loc("Could not run '%1': %2", 'Build install', $buffer));
651 2         155             $fail++;
652                     }
653                 } else {
654 0         0         my %buildflags = $dist->_buildflags_as_hash($buildflags);
655              
656 0         0         eval { $mb->dispatch('install', %buildflags) };
  0         0  
657 0 50       0         if( $@ ) {
658 0         0             error(loc("Could not run '%1': %2", 'Build install', "$@"));
659 0         0             $fail++;
660                     }
661                 }
662              
663              
664 0 0       0     unless( $cb->_chdir( dir => $orig ) ) {
665 0         0         error( loc( "Could not chdir back to start dir '%1'", $orig ) );
666                 }
667              
668 2 50       2746     return $dist->status->installed( $fail ? 0 : 1 );
669             }
670              
671             ### returns the string 'foo=bar zot=quux' as (foo => bar, zot => quux)
672             sub _buildflags_as_hash {
673 0     11   0     my $self = shift;
674 2 50       340     my $flags = shift or return;
675              
676 11         399     my @argv = Module::Build->split_like_shell($flags);
677 11         208     my ($argv) = Module::Build->read_args(@argv);
678              
679 11         1908     return %$argv;
680             }
681              
682              
683             sub dist_dir {
684             ### just in case you already did a create call for this module object
685             ### just via a different dist object
686 11     0 0 1203     my $dist = shift;
687 11         332     my $self = $dist->parent;
688              
689             ### we're also the cpan_dist, since we don't need to have anything
690             ### prepared from another installer
691 0 50             $dist = $self->status->dist_cpan if $self->status->dist_cpan;
692 0               my $mb = $dist->status->_mb_object;
693              
694 0               my $cb = $self->parent;
695 0               my $conf = $cb->configure_object;
696 0               my %hash = @_;
697              
698                 
699 0               my $dir;
700 0 50             unless( $dir = $self->status->extract ) {
701 0                   error( loc( "No dir found to operate on!" ) );
702 0                   return;
703                 }
704                 
705             ### chdir to work directory ###
706 0               my $orig = cwd();
707 0 0             unless( $cb->_chdir( dir => $dir ) ) {
708 0                   error( loc( "Could not chdir to build directory '%1'", $dir ) );
709 0                   return;
710                 }
711              
712 0               my $fail; my $distdir;
  0            
713 0 0             TRY: {
714 0                   $dist->prepare( @_ ) or (++$fail, last TRY);
715              
716              
717 0                   eval { $mb->dispatch('distdir') };
  0            
718 0 0                 if( $@ ) {
719 0                       error(loc("Could not run '%1': %2", 'Build distdir', "$@"));
720 0                       ++$fail, last TRY;
721                     }
722              
723             ### /path/to/Foo-Bar-1.2/Foo-Bar-1.2
724 0                   $distdir = File::Spec->catdir( $dir, $self->package_name . '-' .
725                                                             $self->package_version );
726              
727 0 0                 unless( -d $distdir ) {
728 0                       error(loc("Do not know where '%1' got created", 'distdir'));
729 0                       ++$fail, last TRY;
730                     }
731                 }
732              
733 0 0             unless( $cb->_chdir( dir => $orig ) ) {
734 0                   error( loc( "Could not chdir to start directory '%1'", $orig ) );
735 0                   return;
736                 }
737              
738 0 0             return if $fail;
739 0               return $distdir;
740             }    
741              
742             =head1 KNOWN ISSUES
743            
744             Below are some of the known issues with Module::Build, that we hope
745             the authors will resolve at some point, so we can make full use of
746             Module::Build's power.
747             The number listed is the bug number on C<rt.cpan.org>.
748            
749             =over 4
750            
751             =item * Module::Build can not be upgraded using its own API (#13169)
752            
753             This is due to the fact that the Build file insists on adding a path
754             to C<@INC> which force the loading of the C<not yet installed>
755             Module::Build when it shells out to run it's own build procedure:
756            
757             =item * Module::Build does not provide access to install history (#9793)
758            
759             C<Module::Build> runs the create, test and install procedures in it's
760             own processes, but does not provide access to any diagnostic messages of
761             those processes. As an end result, we can not offer these diagnostic
762             messages when, for example, reporting automated build failures to sites
763             like C<testers.cpan.org>.
764            
765             =back
766            
767             =head1 AUTHOR
768            
769             Originally by Jos Boumans E<lt>kane@cpan.orgE<gt>. Brought to working
770             condition and currently maintained by Ken Williams E<lt>kwilliams@cpan.orgE<gt>.
771            
772             =head1 COPYRIGHT
773            
774             The CPAN++ interface (of which this module is a part of) is
775             copyright (c) 2001, 2002, 2003, 2004, 2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
776             All rights reserved.
777            
778             This library is free software;
779             you may redistribute and/or modify it under the same
780             terms as Perl itself.
781            
782             =cut
783              
784             1;
785              
786             # Local variables:
787             # c-indentation-style: bsd
788             # c-basic-offset: 4
789             # indent-tabs-mode: nil
790             # End:
791             # vim: expandtab shiftwidth=4:
792