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'<