File Coverage

inc/Module/Build/Functions.pm
Criterion Covered Total %
statement 185 654 28.2
branch 31 254 12.2
condition 15 77 19.4
subroutine 33 93 35.4
pod 63 66 95.4
total 327 1144 28.5


line stmt bran cond sub pod time code
1             #line 1
2             package Module::Build::Functions;
3              
4 3     3   16 #<<<
  3         4  
  3         117  
5 3     3   80 use strict;
  3         11  
  3         131  
6 3     3   26 use 5.00503;
  3         8  
  3         224  
7 3     3   16 use vars qw( $VERSION @EXPORT $AUTOLOAD %ARGS);
  3         13  
  3         324  
8 3     3   871 use Carp qw( croak carp confess );
  3         712  
  3         202  
9 3     3   14 use File::Spec::Functions qw( catdir catfile );
  3         16  
  3         48  
10 3     3   15 use Exporter qw();
  3         5  
  3         69  
11 3     3   16 use Cwd qw();
  3         6  
  3         45  
12 3     3   16 use File::Find qw();
  3         5  
  3         55  
13 3     3   2885 use File::Path qw();
  3         4022  
  3         129  
14 3     3   19 use FindBin;
  3         7  
  3         5038  
15             use Config;
16              
17             # The equivalent of "use warnings" pre-5.006.
18             local $^W = 1;
19             my $object = undef;
20             my $class = 'Module::Build';
21             my $mb_required = 0;
22             my $object_created = 0;
23             my $export_to = undef;
24             my $sharemod_used = 1;
25             my (%FLAGS, %ALIASES, %ARRAY, %HASH, @AUTOLOADED, @DEFINED);
26             my @install_types;
27             my %config;
28             #>>>
29              
30             # Whether or not inc::Module::Build::Functions is actually loaded, the
31             # $INC{inc/Module/Build/Functions.pm} is what will still get set as long as
32             # the caller loaded this module in the documented manner.
33             # If not set, the caller may NOT have loaded the bundled version, and thus
34             # they may not have a MBF version that works with the Build.PL. This would
35             # result in false errors or unexpected behaviour. And we don't want that.
36             my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
37             unless ( $INC{$file} ) {
38             die <<"END_DIE" }
39              
40             Please invoke ${\__PACKAGE__} with:
41              
42             use inc::${\__PACKAGE__};
43              
44             not:
45              
46             use ${\__PACKAGE__};
47              
48             END_DIE
49              
50             # To save some more typing in Module::Build::Functions installers, every...
51             # use inc::Module::Build::Functions
52             # ...also acts as an implicit use strict.
53             $^H |= strict::bits(qw(refs subs vars));
54              
55             # import which will also perform self-bundling
56 2     2   21 sub import {
57             $export_to = caller;
58 2         4
59             my $class = shift;
60 2         6  
61             %config = @_;
62 2   50     16  
63 2 50 33     18 $config{prefix} ||= 'inc';
64 2   33     143 $config{author} ||= ( $^O eq 'VMS' ? '_author' : '.author' );
65             $config{base} ||= Cwd::abs_path($FindBin::Bin);
66              
67             # Stripping leading prefix, if this import was called
68 2         38 # from loader (inc::Module::Build::Functions)
69             $class =~ s/^\Q$config{prefix}\E:://;
70 2   33     14  
71 2   33     41 $config{name} ||= $class;
72             $config{version} ||= $class->VERSION;
73 2 50       11  
74 2         6 unless ( $config{path} ) {
75 2         11 $config{path} = $config{name};
76             $config{path} =~ s!::!/!g;
77 2   33     21 }
78             $config{file} ||= "$config{base}/$config{prefix}/$config{path}.pm";
79 2 50 33     55  
      33        
80 0         0 unless ( -f $config{file} || $0 ne 'Build.PL' && $0 ne 'Makefile.PL' ) {
81             File::Path::mkpath("$config{prefix}/$config{author}");
82              
83 0         0 # Bundling its own copy to ./inc
84             _copy( $INC{"$config{path}.pm"} => $config{file} );
85 0 0       0  
  0         0  
86 0         0 unless ( grep { $_ eq $config{prefix} } @INC ) {
87             unshift @INC, $config{prefix};
88             }
89             }
90 2 50       8
91 0         0 if (defined $config{build_class}) {
92             $DB::single = 1;
93 0         0
94             build_class($config{build_class});
95             }
96              
97             {
98             # The export should be performed 1 level up, since we call
99 2         3 # Exporter's 'import' from our 'import'
  2         5  
100             local $Exporter::ExportLevel = 1;
101              
102 2         1166 # Delegating back to Exporter's import
103             &Exporter::import($class);
104             }
105             } ## end sub import
106              
107              
108             # Copy a single package to inc/, with its @ISA tree (note, dependencies are skipped)
109 0     0 0 0 sub copy_package {
110             my ( $pkg, $skip_isa ) = @_;
111 0         0  
112 0         0 my $file = $pkg;
113             $file =~ s!::!/!g;
114 0         0  
115             my $pathname = "$file.pm";
116              
117 0 0       0 # Do not re-require packages
118 0 0       0 eval "require $pkg" unless $INC{$pathname};
119             die "The package [$pkg] not found and cannot be added to ./inc" if $@;
120 0         0  
121 0 0       0 $file = "$config{prefix}/$file.pm";
122             return if -f $file; # prevents infinite recursion
123 0         0  
124             _copy( $INC{$pathname} => $file );
125 0 0       0  
126 0         0 unless ($skip_isa) {
127             my @isa = eval '@' . $pkg . '::ISA';
128 0         0  
129             copy_package($_) foreach (@isa);
130             }
131             } ## end sub copy_package
132              
133             # POD-stripping enabled copy function
134 0     0   0 sub _copy {
135             my ( $from, $to ) = @_;
136 0         0  
137 0         0 my @parts = split( '/', $to );
138             File::Path::mkpath( [ join( '/', @parts[ 0 .. $#parts - 1 ] ) ] );
139 0         0  
140             chomp $to;
141 0         0  
142 0 0       0 local ( *FROM, *TO, $_ );
143 0 0       0 open FROM, "< $from" or die "Can't open $from for input:\n$!";
144 0         0 open TO, "> $to" or die "Can't open $to for output:\n$!";
145             print TO "#line 1\n";
146 0         0  
147             my $content;
148             my $in_pod;
149 0         0  
150 0 0 0     0 while () {
    0          
    0          
151 0         0 if (/^=(?:b(?:egin|ack)|head\d|(?:po|en)d|item|(?:ove|fo)r)/) {
152             $in_pod = 1;
153 0         0 } elsif ( /^=cut\s*\z/ and $in_pod ) {
154 0         0 $in_pod = 0;
155             print TO "#line $.\n";
156 0         0 } elsif ( !$in_pod ) {
157             print TO $_;
158             }
159             }
160 0         0  
161 0         0 close FROM;
162             close TO;
163 0         0  
164             print "include $to\n";
165             } ## end sub _copy
166              
167 3     3   11 BEGIN {
168             $VERSION = '0.02';
169 3         11  
170             *inc::Module::Build::Functions::VERSION = *VERSION;
171              
172             # Very important line which turns a loader (inc::Module::Build::Functions)
173 3         105 # into our subclass, thus provides an 'import' function to it
174             @inc::Module::Build::Functions::ISA = __PACKAGE__;
175 3         377323  
176             require Module::Build;
177              
178             # Module implementation here
179              
180 3 50       1102330 # Set defaults.
181 3         11 if ( $Module::Build::VERSION >= 0.28 ) {
182 3         8 $ARGS{create_packlist} = 1;
183             $mb_required = '0.28';
184             }
185              
186 3         58 %FLAGS = (
187             'create_makefile_pl' => [ '0.19', 0 ],
188             'c_source' => [ '0.04', 0 ],
189             'dist_abstract' => [ '0.20', 0 ],
190             'dist_name' => [ '0.11', 0 ],
191             'dist_version' => [ '0.11', 0 ],
192             'dist_version_from' => [ '0.11', 0 ],
193             'installdirs' => [ '0.19', 0 ],
194             'license' => [ '0.11', 0 ],
195             'create_packlist' => [ '0.28', 1 ],
196             'create_readme' => [ '0.22', 1 ],
197             'create_license' => [ '0.31', 1 ],
198             'dynamic_config' => [ '0.07', 1 ],
199             'use_tap_harness' => [ '0.30', 1 ],
200             'sign' => [ '0.16', 1 ],
201             'recursive_test_files' => [ '0.28', 1 ],
202             );
203 3         45  
204             %ALIASES = (
205             'test_requires' => 'build_requires',
206             'abstract' => 'dist_abstract',
207             'name' => 'module_name',
208             'author' => 'dist_author',
209             'version' => 'dist_version',
210             'version_from' => 'dist_version_from',
211             'extra_compiler_flag' => 'extra_compiler_flags',
212             'extra_linker_flag' => 'extra_linker_flags',
213             'include_dir' => 'include_dirs',
214             'pl_file' => 'PL_files',
215             'pl_files' => 'PL_files',
216             'PL_file' => 'PL_files',
217             'pm_file' => 'pm_files',
218             'pod_file' => 'pod_files',
219             'xs_file' => 'xs_files',
220             'test_file' => 'test_files',
221             'script_file' => 'script_files',
222             );
223 3         15  
224             %ARRAY = (
225             'autosplit' => '0.04',
226             'add_to_cleanup' => '0.19',
227             'include_dirs' => '0.24',
228             'dist_author' => '0.20',
229             );
230 3         38  
231             %HASH = (
232             'configure_requires' => [ '0.30', 1 ],
233             'build_requires' => [ '0.07', 1 ],
234             'conflicts' => [ '0.07', 1 ],
235             'recommends' => [ '0.08', 1 ],
236             'requires' => [ '0.07', 1 ],
237             'get_options' => [ '0.26', 0 ],
238             'meta_add' => [ '0.28', 0 ],
239             'pm_files' => [ '0.19', 0 ],
240             'pod_files' => [ '0.19', 0 ],
241             'xs_files' => [ '0.19', 0 ],
242             'install_path' => [ '0.19', 0 ],
243             );
244 3         60  
245             @AUTOLOADED = ( keys %HASH, keys %ARRAY, keys %ALIASES, keys %FLAGS );
246 3         57  
247             @DEFINED = qw(
248             all_from abstract_from author_from license_from perl_version
249             perl_version_from install_script install_as_core install_as_cpan
250             install_as_site install_as_vendor WriteAll auto_install auto_bundle
251             bundle bundle_deps auto_bundle_deps can_use can_run can_cc
252             requires_external_bin requires_external_cc get_file check_nmake
253             interactive release_testing automated_testing win32 winlike
254             author_context install_share auto_features extra_compiler_flags
255             extra_linker_flags module_name no_index PL_files script_files test_files
256             tap_harness_args subclass create_build_script get_builder build_class
257             repository bugtracker meta_merge cygwin
258 3         34 );
259             @EXPORT = ( 'AUTOLOAD', @DEFINED, @AUTOLOADED );
260 3         15187
261             $DB::single = 1;
262              
263             } ## end BEGIN
264              
265             # The autoload handles 4 types of "similar" routines, for 45 names.
266 12     12   18 sub AUTOLOAD {
267 12         57 my $full_sub = $AUTOLOAD;
268             my ($sub) = $AUTOLOAD =~ m{\A.*::([^:]*)\z}x;
269 12 100       32  
270 1         2 if ( exists $ALIASES{$sub} ) {
271 1     3 1 46 my $alias = $ALIASES{$sub};
  3         38  
  3         5  
272             eval <<"END_OF_CODE";
273             sub $full_sub {
274             $alias(\@_);
275             return;
276             }
277 1         2 END_OF_CODE
  1         21  
278             goto &{$full_sub};
279             }
280 11 100       23  
281 6         13 if ( exists $FLAGS{$sub} ) {
282 6 100       15 my $boolean_version = $FLAGS{$sub}[0];
283 6 100       13 my $boolean_default = $FLAGS{$sub}[1] ? ' || 1' : q{};
284 6   50 1 1 372 my $boolean_normal = $FLAGS{$sub}[1] ? q{!!} : q{};
  1   50 1 1 6  
  1     1 1 2  
  1     1 1 4  
  1     1 1 2  
  1     1 1 3  
  1         4  
  1         4  
  1         3  
  1         5  
  1         3  
  1         3  
  1         3  
  1         2  
  1         2  
  1         4  
  1         2  
  1         2  
  1         2  
  1         3  
  1         2  
  1         2  
  1         3  
  1         4  
  1         2  
285             eval <<"END_OF_CODE";
286             sub $full_sub {
287             my \$argument = shift$boolean_default;
288             \$ARGS{$sub} = $boolean_normal \$argument;
289             _mb_required('$boolean_version');
290             return;
291             }
292 6         7 END_OF_CODE
  6         144  
293             goto &{$full_sub};
294             } ## end if ( exists $FLAGS{$sub...})
295 5 100       12  
296             if ( exists $ARRAY{$sub} ) {
297 2         4  
298 2         9 my $array_version = $ARRAY{$sub};
299             my $code_array = <<"END_OF_CODE";
300             sub $full_sub {
301             my \$argument = shift;
302             if ( 'ARRAY' eq ref \$argument ) {
303             foreach my \$f ( \@{\$argument} ) {
304             $sub(\$f);
305             }
306             return;
307             }
308            
309             my \@array;
310             if (exists \$ARGS{$sub}) {
311             \$ARGS{$sub} = [ \@{ \$ARGS{$sub} }, \$argument ];
312             } else {
313             \$ARGS{$sub} = [ \$argument ];
314             }
315             _mb_required('$array_version');
316             return;
317             }
318 2 50   1 1 292 END_OF_CODE
  1 50   1 1 3  
  1 50       5  
  0 50       0  
  0         0  
  0         0  
  0         0  
  1         2  
  1         5  
  0         0  
  0         0  
  1         3  
  1         4  
  1         3  
  1         3  
  1         4  
  0         0  
  0         0  
  0         0  
  0         0  
  1         2  
  1         5  
  0         0  
  0         0  
  1         4  
  1         3  
  1         2  
319 2         5 eval $code_array;
  2         53  
320             goto &{$full_sub};
321             } ## end if ( exists $ARRAY{$sub...})
322 3 50       8  
323 3         6 if ( exists $HASH{$sub} ) {
324 3         4 _create_hashref($sub);
325 3 50       7 my $hash_version = $HASH{$sub}[0];
326 3         13 my $hash_default = $HASH{$sub}[1] ? ' || 0' : q{};
327             my $code_hash = <<"END_OF_CODE";
328             sub $full_sub {
329             my \$argument1 = shift;
330             my \$argument2 = shift$hash_default;
331             if ( 'HASH' eq ref \$argument1 ) {
332             my ( \$k, \$v );
333             while ( ( \$k, \$v ) = each \%{\$argument1} ) {
334             $sub( \$k, \$v );
335             }
336             return;
337             }
338              
339             \$ARGS{$sub}{\$argument1} = \$argument2;
340             _mb_required('$hash_version');
341             return;
342             }
343 3 50 100 4 1 344 END_OF_CODE
  4 50 50 1 1 7  
  4 50 100 3 1 12  
  4         10  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  4         10  
  4         10  
  4         45  
  1         3  
  1         5  
  1         4  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  1         3  
  1         4  
  1         3  
  3         5  
  3         11  
  3         7  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  3         7  
  3         7  
  3         6  
344 3         5 eval $code_hash;
  3         64  
345             goto &{$full_sub};
346             } ## end if ( exists $HASH{$sub...})
347 0         0  
348             croak "$sub cannot be found";
349             } ## end sub AUTOLOAD
350              
351 17     17   20 sub _mb_required {
352 17 100       49 my $version = shift;
353 4         5 if ( $version > $mb_required ) {
354             $mb_required = $version;
355 17         268 }
356             return;
357             }
358              
359 0 0   0   0 sub _installdir {
360 0 0       0 return $Config{'sitelibexp'} unless ( defined $ARGS{install_type} );
361 0 0       0 return $Config{'sitelibexp'} if ( 'site' eq $ARGS{install_type} );
362 0 0       0 return $Config{'privlibexp'} if ( 'perl' eq $ARGS{install_type} );
363 0         0 return $Config{'vendorlibexp'} if ( 'vendor' eq $ARGS{install_type} );
364             croak 'Invalid install type';
365             }
366              
367 0     0   0 sub _create_arrayref {
368 0 0       0 my $name = shift;
369 0         0 unless ( exists $ARGS{$name} ) {
370             $ARGS{$name} = [];
371 0         0 }
372             return;
373             }
374              
375              
376 3     3   5 sub _create_hashref {
377 3 50       7 my $name = shift;
378 3         6 unless ( exists $ARGS{$name} ) {
379             $ARGS{$name} = {};
380 3         6 }
381             return;
382             }
383              
384 0     0   0 sub _create_hashref_arrayref {
385 0         0 my $name1 = shift;
386 0 0       0 my $name2 = shift;
387 0         0 unless ( exists $ARGS{$name1}{$name2} ) {
388             $ARGS{$name1}{$name2} = [];
389 0         0 }
390             return;
391             }
392              
393 0     0   0 sub _slurp_file {
394 0         0 my $name = shift;
395             my $file_handle;
396 0 0       0  
397 0         0 if ( $] < 5.006 ) {
398 0         0 require Symbol;
399 0 0       0 $file_handle = Symbol::gensym();
400             open $file_handle, "<$name"
401             or croak $!;
402 0 0       0 } else {
403             open $file_handle, '<', $name
404             or croak $!;
405             }
406 0         0  
407 0         0 local $/ = undef; # enable localized slurp mode
408             my $content = <$file_handle>;
409 0         0  
410 0         0 close $file_handle;
411             return $content;
412             } ## end sub _slurp_file
413              
414             # Module::Install syntax below.
415              
416 0     0 1 0 sub all_from {
417             my $file = shift;
418 0         0  
419 0         0 abstract_from($file);
420 0         0 author_from($file);
421 0         0 version_from($file);
422 0         0 license_from($file);
423 0         0 perl_version_from($file);
424             return;
425             }
426              
427 0     0 1 0 sub abstract_from {
428             my $file = shift;
429 0         0  
430 0         0 require ExtUtils::MM_Unix;
431             abstract(
432             bless( { DISTNAME => $ARGS{module_name} }, 'ExtUtils::MM_Unix' )
433             ->parse_abstract($file) );
434 0         0  
435             return;
436             }
437              
438             # Borrowed from Module::Install::Metadata->author_from
439 0     0 1 0 sub author_from {
440 0         0 my $file = shift;
441 0         0 my $content = _slurp_file($file);
442             my $author;
443 0 0       0  
    0          
444             if ($content =~ m{
445             =head \d \s+ (?:authors?)\b \s*
446             (.*?)
447             =head \d
448             }ixms
449             )
450             {
451              
452 0         0 # Grab all author lines.
453             my $authors = $1;
454              
455 0         0 # Now break up each line.
456 0         0 while ( $authors =~ m{\G([^\n]+) \s*}gcixms ) {
457             $author = $1;
458              
459 0         0 # Convert E and E into the right characters.
460 0         0 $author =~ s{E}{<}g;
461             $author =~ s{E}{>}g;
462              
463 0 0       0 # Remove new-style C<< >> markers.
464 0         0 if ( $author =~ m{\A(.*?) \s* C<< \s* (.*?) \s* >>}msx ) {
465             $author = "$1 $2";
466 0         0 }
467             dist_author($author);
468             } ## end while ( $authors =~ m{\G([^\n]+) \s*}gcixms)
469             } elsif (
470             $content =~ m{
471             =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
472             .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
473             ([^\n]*)
474             }ixms
475             )
476 0         0 {
477             $author = $1;
478              
479 0         0 # Convert E and E into the right characters.
480 0         0 $author =~ s{E}{<}g;
481             $author =~ s{E}{>}g;
482              
483 0 0       0 # Remove new-style C<< >> markers.
484 0         0 if ( $author =~ m{\A(.*?) \s* C<< \s* (.*?) \s* >>}msx ) {
485             $author = "$1 $2";
486 0         0 }
487             dist_author($author);
488 0         0 } else {
489             carp "Cannot determine author info from $file";
490             }
491 0         0  
492             return;
493             } ## end sub author_from
494              
495             # Borrowed from Module::Install::Metadata->license_from
496 0     0 1 0 sub license_from {
497 0         0 my $file = shift;
498 0 0       0 my $content = _slurp_file($file);
499             if ($content =~ m{
500             (
501             =head \d \s+
502             (?:licen[cs]e|licensing|copyright|legal)\b
503             .*?
504             )
505             (=head\\d.*|=cut.*|)
506             \z
507             }ixms
508             )
509 0         0 {
510             my $license_text = $1;
511 0         0 #<<<
512             my @phrases = (
513             'under the same (?:terms|license) as perl itself' => 'perl', 1,
514             'GNU general public license' => 'gpl', 1,
515             'GNU public license' => 'gpl', 1,
516             'GNU lesser general public license' => 'lgpl', 1,
517             'GNU lesser public license' => 'lgpl', 1,
518             'GNU library general public license' => 'lgpl', 1,
519             'GNU library public license' => 'lgpl', 1,
520             'BSD license' => 'bsd', 1,
521             'Artistic license' => 'artistic', 1,
522             'GPL' => 'gpl', 1,
523             'LGPL' => 'lgpl', 1,
524             'BSD' => 'bsd', 1,
525             'Artistic' => 'artistic', 1,
526             'MIT' => 'mit', 1,
527             'proprietary' => 'restrictive', 0,
528             );
529 0         0 #>>>
530 0         0 while ( my ( $pattern, $license, $osi ) = splice @phrases, 0, 3 ) {
531 0 0       0 $pattern =~ s{\s+}{\\s+}g;
532 0         0 if ( $license_text =~ /\b$pattern\b/ix ) {
533 0         0 license($license);
534             return;
535             }
536             }
537             } ## end if ( $content =~ m{ ) (})
538 0         0  
539 0         0 carp "Cannot determine license info from $file";
540 0         0 license('unknown');
541             return;
542             } ## end sub license_from
543              
544 1     1 1 4 sub perl_version {
545 1         2 requires( 'perl', @_ );
546             return;
547             }
548              
549             # Borrowed from Module::Install::Metadata->license_from
550 0     0 1 0 sub perl_version_from {
551 0         0 my $file = shift;
552 0 0       0 my $content = _slurp_file($file);
553             if ($content =~ m{
554             ^ # Start of LINE, not start of STRING.
555             (?:use|require) \s*
556             v?
557             ([\d_\.]+)
558             \s* ;
559             }ixms
560             )
561 0         0 {
562 0         0 my $perl_version = $1;
563 0         0 $perl_version =~ s{_}{}g;
564             perl_version($perl_version);
565 0         0 } else {
566             carp "Cannot determine perl version info from $file";
567             }
568 0         0  
569             return;
570             } ## end sub perl_version_from
571              
572 0     0 1 0 sub install_script {
573 0         0 my @scripts = @_;
574 0 0 0     0 foreach my $script (@scripts) {
    0          
575 0         0 if ( -f $script ) {
576             script_files($_);
577 0         0 } elsif ( -d 'script' and -f "script/$script" ) {
578             script_files("script/$script");
579 0         0 } else {
580             croak "Cannot find script '$script'";
581             }
582             }
583 0         0  
584             return;
585             } ## end sub install_script
586              
587 0     0 1 0 sub install_as_core {
588             return installdirs('perl');
589             }
590              
591 0     0 1 0 sub install_as_cpan {
592             return installdirs('site');
593             }
594              
595 0     0 1 0 sub install_as_site {
596             return installdirs('site');
597             }
598              
599 0     0 1 0 sub install_as_vendor {
600             return installdirs('vendor');
601             }
602              
603 0     0 1 0 sub WriteAll { ## no critic(Capitalization)
604 0         0 my $answer = create_build_script();
605             return $answer;
606             }
607              
608             # Module::Install::AutoInstall
609              
610 0     0 1 0 sub auto_install {
611             croak 'auto_install is deprecated';
612             }
613              
614             # Module::Install::Bundle
615              
616 0     0 1 0 sub auto_bundle {
617             croak 'auto_bundle is deprecated';
618             }
619              
620 0     0 1 0 sub bundle {
621             croak 'bundle is deprecated';
622             }
623              
624 0     0 1 0 sub bundle_deps {
625             croak 'bundle_deps is deprecated';
626             }
627              
628 0     0 1 0 sub auto_bundle_deps {
629             croak 'auto_bundle_deps is deprecated';
630             }
631              
632             # Module::Install::Can
633              
634 0     0 1 0 sub can_use {
635             my ( $mod, $ver ) = @_;
636 0         0  
637 0         0 my $file = $mod;
638 0 0       0 $file =~ s{::|\\}{/}g;
639             $file .= '.pm' unless $file =~ /\.pm$/i;
640 0         0  
641 0   0     0 local $@ = undef;
  0         0  
  0         0  
  0         0  
642             return eval { require $file; $mod->VERSION( $ver || 0 ); 1 };
643             }
644              
645 0     0 1 0 sub can_run {
646 0         0 my $cmd = shift;
647 0 0       0 require ExtUtils::MakeMaker;
648             if ( $^O eq 'cygwin' ) {
649              
650 0         0 # MM->maybe_command is fixed in 6.51_01 for Cygwin.
651             ExtUtils::MakeMaker->import(6.52);
652             }
653 0         0  
654 0 0 0     0 my $_cmd = $cmd;
655             return $_cmd if ( -x $_cmd or $_cmd = MM->maybe_command($_cmd) );
656 0         0  
657             for my $dir ( ( split /$Config::Config{path_sep}/x, $ENV{PATH} ), q{.} )
658 0 0       0 {
659 0         0 next if $dir eq q{};
660 0 0 0     0 my $abs = File::Spec->catfile( $dir, $cmd );
661             return $abs if ( -x $abs or $abs = MM->maybe_command($abs) );
662             }
663 0         0  
664             return;
665             } ## end sub can_run
666              
667 0     0 1 0 sub can_cc {
668 0         0 return eval {
669 0         0 require ExtUtils::CBuilder;
670             ExtUtils::CBuilder->new()->have_compiler();
671             };
672             }
673              
674             # Module::Install::External
675              
676 0     0 1 0 sub requires_external_bin {
677 0 0       0 my ( $bin, $version ) = @_;
678 0         0 if ($version) {
679             croak 'requires_external_bin does not support versions yet';
680             }
681              
682 0         0 # Locate the bin
683 0         0 print "Locating required external dependency bin: $bin...";
684 0 0       0 my $found_bin = can_run($bin);
685 0         0 if ($found_bin) {
686             print " found at $found_bin.\n";
687 0         0 } else {
688 0         0 print " missing.\n";
689 0         0 print "Unresolvable missing external dependency.\n";
690 0         0 print "Please install '$bin' seperately and try again.\n";
  0         0  
691             print {*STDERR}
692 0         0 "NA: Unable to build distribution on this platform.\n";
693             exit 0;
694             }
695 0         0  
696             return 1;
697             } ## end sub requires_external_bin
698              
699 0 0   0 1 0 sub requires_external_cc {
700 0         0 unless ( can_cc() ) {
701 0         0 print "Unresolvable missing external dependency.\n";
702 0         0 print "This package requires a C compiler.\n";
  0         0  
703             print {*STDERR}
704 0         0 "NA: Unable to build distribution on this platform.\n";
705             exit 0;
706             }
707 0         0  
708             return 1;
709             }
710              
711             # Module::Install::Fetch
712              
713 0     0 1 0 sub get_file {
714             croak
715             'get_file is not supported - replace by code in a Module::Build subclass.';
716             }
717              
718             # Module::Install::Win32
719              
720 0     0 1 0 sub check_nmake {
721             croak
722             'check_nmake is not supported - replace by code in a Module::Build subclass.';
723             }
724              
725             # Module::Install::With
726              
727 0     0 1 0 sub release_testing {
728             return !!$ENV{RELEASE_TESTING};
729             }
730              
731 0     0 1 0 sub automated_testing {
732             return !!$ENV{AUTOMATED_TESTING};
733             }
734              
735             # Mostly borrowed from Scalar::Util::openhandle, since I should
736             # not use modules that were non-core in 5.005.
737 0     0   0 sub _openhandle {
738 0   0     0 my $fh = shift;
739             my $rt = reftype($fh) || q{};
740 0 0       0  
    0          
741             return ( ( defined fileno $fh ) ? $fh : undef )
742             if $rt eq 'IO';
743 0 0       0  
744 0         0 if ( $rt ne 'GLOB' ) {
745             return;
746             }
747 0 0 0     0  
748             return ( tied *{$fh} or defined fileno $fh ) ? $fh : undef;
749             } ## end sub _openhandle
750              
751             # Mostly borrowed from IO::Interactive::is_interactive, since I should
752             # not use modules that were non-core in 5.005.
753             sub interactive {
754              
755             # If we're doing automated testing, we assume that we don't have
756 0 0   0 1 0 # a terminal, even if we otherwise would.
757             return 0 if automated_testing();
758              
759 0 0       0 # Not interactive if output is not to terminal...
760             return 0 if not -t *STDOUT;
761              
762 0 0       0 # If *ARGV is opened, we're interactive if...
763             if ( _openhandle(*ARGV) ) {
764              
765 0 0 0     0 # ...it's currently opened to the magic '-' file
766             return -t *STDIN if defined $ARGV && $ARGV eq q{-};
767              
768 0 0 0     0 # ...it's at end-of-file and the next file is the magic '-' file
769             return @ARGV > 0 && $ARGV[0] eq q{-} && -t *STDIN if eof *ARGV;
770              
771 0         0 # ...it's directly attached to the terminal
772             return -t *ARGV;
773             }
774              
775             # If *ARGV isn't opened, it will be interactive if *STDIN is attached
776             # to a terminal.
777 0         0 else {
778             return -t *STDIN;
779             }
780             } ## end sub interactive
781              
782 0     0 1 0 sub win32 {
783             return !!( $^O eq 'MSWin32' );
784             }
785              
786 0     0 1 0 sub cygwin {
787             return !!( $^O eq 'cygwin' );
788             }
789              
790 0   0 0 1 0 sub winlike {
791             return !!( $^O eq 'MSWin32' or $^O eq 'cygwin' );
792             }
793              
794 0 0   0 1 0 sub author_context {
795 0 0       0 return 1 if -d 'inc/.author';
796 0 0       0 return 1 if -d 'inc/_author';
797 0 0       0 return 1 if -d '.svn';
798 0 0       0 return 1 if -f '.cvsignore';
799 0 0       0 return 1 if -f '.gitignore';
800 0         0 return 1 if -f 'MANIFEST.SKIP';
801             return 0;
802             }
803              
804             # Module::Install::Share
805              
806 0     0   0 sub _scan_dir {
807             my ( $srcdir, $destdir, $unixdir, $type, $files ) = @_;
808 0         0  
809             my $type_files = $type . '_files';
810 0 0       0  
811             $ARGS{$type_files} = {} unless exists $ARGS{"$type_files"};
812 0         0  
813             my $dir_handle;
814 0 0       0  
815 0         0 if ( $] < 5.006 ) {
816 0         0 require Symbol;
817             $dir_handle = Symbol::gensym();
818             }
819 0 0       0  
820             opendir $dir_handle, $srcdir or croak $!;
821              
822 0         0 FILE:
823 0 0       0 foreach my $direntry ( readdir $dir_handle ) {
824 0 0       0 if ( -d catdir( $srcdir, $direntry ) ) {
825 0 0       0 next FILE if ( $direntry eq q{.} );
826 0         0 next FILE if ( $direntry eq q{..} );
827             _scan_dir(
828             catdir( $srcdir, $direntry ),
829             catdir( $destdir, $direntry ),
830             File::Spec::Unix->catdir( $unixdir, $direntry ),
831             $type,
832             $files
833             );
834 0         0 } else {
835 0         0 my $sourcefile = catfile( $srcdir, $direntry );
836 0 0       0 my $unixfile = File::Spec::Unix->catfile( $unixdir, $direntry );
837 0         0 if ( exists $files->{$unixfile} ) {
838             $ARGS{$type_files}{$sourcefile} =
839             catfile( $destdir, $direntry );
840             }
841             }
842             } ## end foreach my $direntry ( readdir...)
843 0         0  
844             closedir $dir_handle;
845 0         0  
846             return;
847             } ## end sub _scan_dir
848              
849 0 0   0 1 0 sub install_share {
850 0 0       0 my $dir = @_ ? pop : 'share';
851             my $type = @_ ? shift : 'dist';
852 0 0 0     0  
      0        
853             unless ( defined $type
854             and ( ( $type eq 'module' ) or ( $type eq 'dist' ) ) )
855 0         0 {
856             croak "Illegal or invalid share dir type '$type'";
857 0 0 0     0 }
858 0         0 unless ( defined $dir and -d $dir ) {
859             croak 'Illegal or missing directory install_share param';
860             }
861 0         0  
862 0         0 require File::Spec::Unix;
863 0         0 require ExtUtils::Manifest;
864 0 0       0 my $files = ExtUtils::Manifest::maniread();
865 0         0 if ( 0 == scalar(%$files) ) {
866             croak 'Empty or no MANIFEST file';
867 0         0 }
868             my $installation_path;
869             my $sharecode;
870 0 0       0  
871 0 0       0 if ( $type eq 'dist' ) {
872             croak 'Too many parameters to install_share' if @_;
873 0         0  
874             my $dist = $ARGS{'dist_name'};
875 0         0  
876             $installation_path =
877 0         0 catdir( _installdir(), qw(auto share dist), $dist );
878 0         0 _scan_dir( $dir, 'share', $dir, 'share', $files );
879 0         0 push @install_types, 'share';
880             $sharecode = 'share';
881 0         0 } else {
882             my $module = shift;
883 0 0       0  
884 0         0 unless ( defined $module ) {
885             croak "Missing or invalid module name '$module'";
886             }
887 0         0  
888 0         0 $module =~ s/::/-/g;
889             $installation_path =
890 0         0 catdir( _installdir(), qw(auto share module), $module );
891 0         0 $sharecode = 'share_d' . $sharemod_used;
892 0         0 _scan_dir( $dir, $sharecode, $dir, $sharecode, $files );
893 0         0 push @install_types, $sharecode;
894             $sharemod_used++;
895             } ## end else [ if ( $type eq 'dist' )]
896              
897 0         0 # Set the path to install to.
898             install_path( $sharecode, $installation_path );
899              
900 0 0       0 # This helps for testing purposes...
901             if ( $Module::Build::VERSION >= 0.31 ) {
902 0     0   0 Module::Build->add_property( $sharecode . '_files',
  0         0  
903             default => sub { return {} } );
904             }
905              
906 0         0 # 99% of the time we don't want to index a shared dir
907             no_index($dir);
908              
909 0         0 # This construction requires 0.26.
910 0         0 _mb_required('0.26');
911             return;
912             } ## end sub install_share
913              
914             # Module::Build syntax
915              
916 0     0   0 sub _af_hashref {
917 0 0       0 my $feature = shift;
918 0         0 unless ( exists $ARGS{auto_features} ) {
919             $ARGS{auto_features} = {};
920 0 0       0 }
921 0         0 unless ( exists $ARGS{auto_features}{$feature} ) {
922 0         0 $ARGS{auto_features}{$feature} = {};
923             $ARGS{auto_features}{$feature}{requires} = {};
924 0         0 }
925             return;
926             }
927              
928 0     0 1 0 sub auto_features {
929 0         0 my $feature = shift;
930 0         0 my $type = shift;
931 0         0 my $param1 = shift;
932 0         0 my $param2 = shift;
933             _af_hashref($type);
934 0 0       0  
    0          
935 0         0 if ( 'description' eq $type ) {
936             $ARGS{auto_features}{$feature}{description} = $param1;
937 0         0 } elsif ( 'requires' eq $type ) {
938             $ARGS{auto_features}{$feature}{requires}{$param1} = $param2;
939 0         0 } else {
940             croak "Invalid type $type for auto_features";
941 0         0 }
942 0         0 _mb_required('0.26');
943             return;
944             } ## end sub auto_features
945              
946 0     0 1 0 sub extra_compiler_flags {
947 0 0       0 my $flag = shift;
948 0         0 if ( 'ARRAY' eq ref $flag ) {
  0         0  
949 0         0 foreach my $f ( @{$flag} ) {
950             extra_compiler_flags($f);
951             }
952             }
953 0 0       0  
954 0         0 if ( $flag =~ m{\s} ) {
955 0         0 my @flags = split m{\s+}, $flag;
956 0         0 foreach my $f (@flags) {
957             extra_compiler_flags($f);
958             }
959 0         0 } else {
960 0         0 _create_arrayref('extra_compiler_flags');
  0         0  
961             push @{ $ARGS{'extra_compiler_flags'} }, $flag;
962 0         0 }
963 0         0 _mb_required('0.19');
964             return;
965             } ## end sub extra_compiler_flags
966              
967 0     0 1 0 sub extra_linker_flags {
968 0 0       0 my $flag = shift;
969 0         0 if ( 'ARRAY' eq ref $flag ) {
  0         0  
970 0         0 foreach my $f ( @{$flag} ) {
971             extra_linker_flags($f);
972             }
973             }
974 0 0       0  
975 0         0 if ( $flag =~ m{\s} ) {
976 0         0 my @flags = split m{\s+}, $flag;
977 0         0 foreach my $f (@flags) {
978             extra_linker_flags($f);
979             }
980 0         0 } else {
981 0         0 _create_arrayref('extra_linker_flags');
  0         0  
982             push @{ $ARGS{'extra_linker_flags'} }, $flag;
983 0         0 }
984 0         0 _mb_required('0.19');
985             return;
986             } ## end sub extra_linker_flags
987              
988 1     1 1 3 sub module_name {
989 1         2 my ($name) = shift;
990 1 50       4 $ARGS{'module_name'} = $name;
991 1         2 unless ( exists $ARGS{'dist_name'} ) {
992 1         3 my $dist_name = $name;
993 1         5 $dist_name =~ s/::/-/g;
994             dist_name($dist_name);
995 1         3 }
996 1         2 _mb_required('0.03');
997             return;
998             }
999              
1000 0     0 1 0 sub no_index {
1001 0   0     0 my $name = pop;
1002             my $type = shift || 'directory';
1003              
1004             # TODO: compatibility code.
1005 0         0  
1006 0         0 _create_hashref('no_index');
1007 0         0 _create_hashref_arrayref( 'no_index', $type );
  0         0  
1008 0         0 push @{ $ARGS{'no_index'}{$type} }, $name;
1009 0         0 _mb_required('0.28');
1010             return;
1011             } ## end sub no_index
1012              
1013 0     0 1 0 sub PL_files { ## no critic(Capitalization)
1014 0   0     0 my $pl_file = shift;
1015 0 0       0 my $pm_file = shift || [];
1016 0         0 if ( 'HASH' eq ref $pl_file ) {
1017 0         0 my ( $k, $v );
  0         0  
1018 0         0 while ( ( $k, $v ) = each %{$pl_file} ) {
1019             PL_files( $k, $v );
1020             }
1021             }
1022 0         0  
1023 0         0 _create_hashref('PL_files');
1024 0         0 $ARGS{PL_files}{$pl_file} = $pm_file;
1025 0         0 _mb_required('0.06');
1026             return;
1027             } ## end sub PL_files
1028              
1029 0     0 1 0 sub meta_merge {
1030 0         0 my $key = shift;
1031 0 0       0 my $value = shift;
1032 0         0 if ( 'HASH' eq ref $key ) {
1033 0         0 my ( $k, $v );
  0         0  
1034 0         0 while ( ( $k, $v ) = each %{$key} ) {
1035             meta_merge( $k, $v );
1036 0         0 }
1037             return;
1038             }
1039              
1040 0 0       0 # Allow omitting hashrefs, if there's one more parameter.
    0          
1041 0         0 if ( 1 == scalar @_ ) {
1042 0         0 meta_merge( $key, { $value => shift } );
1043             return;
1044 0         0 } elsif ( 0 != scalar @_ ) {
1045             confess 'Too many parameters to meta_merge';
1046             }
1047 0 0 0     0  
1048             if ( ( defined $ARGS{meta_merge}{$key} )
1049             and ( ref $value ne ref $ARGS{meta_merge}{$key} ) )
1050 0         0 {
1051             confess
1052             'Mismatch between value to merge into meta information and value already there';
1053             }
1054 0 0       0  
    0          
1055 0         0 if ( 'HASH' eq ref $ARGS{meta_merge}{$key} ) {
1056 0         0 $ARGS{meta_merge}{$key} =
  0         0  
1057             { ( %{ $ARGS{meta_merge}{$key} } ), ( %{$value} ) };
1058 0         0 } elsif ( 'ARRAY' eq ref $ARGS{meta_merge}{$key} ) {
1059 0         0 $ARGS{meta_merge}{$key} =
  0         0  
1060             \( @{ $ARGS{meta_merge}{$key} }, @{$value} );
1061 0         0 } else {
1062             $ARGS{meta_merge}{$key} = $value;
1063             }
1064 0         0  
1065 0         0 _mb_required('0.28');
1066             return;
1067             } ## end sub meta_merge
1068              
1069              
1070 0     0 1 0 sub repository {
1071 0         0 my $url = shift;
1072 0         0 meta_merge( 'resources', 'repository' => $url );
1073             return;
1074             }
1075              
1076 0     0 1 0 sub bugtracker {
1077 0         0 my $url = shift;
1078 0         0 meta_merge( 'resources', 'bugtracker' => $url );
1079             return;
1080             }
1081              
1082 0     0 1 0 sub script_files {
1083 0 0       0 my $file = shift;
1084 0         0 if ( 'ARRAY' eq ref $file ) {
  0         0  
1085 0         0 foreach my $f ( @{$file} ) {
1086             script_files($f);
1087             }
1088             }
1089 0 0       0  
1090 0 0       0 if ( -d $file ) {
1091 0 0       0 if ( exists $ARGS{'script_files'} ) {
1092 0         0 if ( 'ARRAY' eq ref $ARGS{'script_files'} ) {
1093             croak
1094             "cannot add directory $file to a list of script_files";
1095 0         0 } else {
1096             croak
1097             "attempt to overwrite string script_files with $file failed";
1098             }
1099 0         0 } else {
1100             $ARGS{'script_files'} = $file;
1101             }
1102 0         0 } else {
1103 0         0 _create_arrayref('script_files');
  0         0  
1104             push @{ $ARGS{'script_files'} }, $file;
1105 0         0 }
1106 0         0 _mb_required('0.18');
1107             return;
1108             } ## end sub script_files
1109              
1110 0     0 1 0 sub test_files {
1111 0 0       0 my $file = shift;
1112 0         0 if ( 'ARRAY' eq ref $file ) {
  0         0  
1113 0         0 foreach my $f ( @{$file} ) {
1114             test_files($f);
1115             }
1116             }
1117 0 0       0  
1118 0 0       0 if ( $file =~ /[*?]/ ) {
1119 0 0       0 if ( exists $ARGS{'test_files'} ) {
1120 0         0 if ( 'ARRAY' eq ref $ARGS{'test_files'} ) {
1121             croak 'cannot add a glob to a list of test_files';
1122 0         0 } else {
1123             croak 'attempt to overwrite string test_files failed';
1124             }
1125 0         0 } else {
1126             $ARGS{'test_files'} = $file;
1127             }
1128 0         0 } else {
1129 0         0 _create_arrayref('test_files');
  0         0  
1130             push @{ $ARGS{'test_files'} }, $file;
1131 0         0 }
1132 0         0 _mb_required('0.23');
1133             return;
1134             } ## end sub test_files
1135              
1136 0     0 1 0 sub tap_harness_args {
1137 0         0 my ($thargs) = shift;
1138 0         0 $ARGS{'tap_harness_args'} = $thargs;
1139 0         0 use_tap_harness(1);
1140             return;
1141             }
1142              
1143 0     0 1 0 sub build_class {
1144             my $further_class = $ARGS{build_class} = shift;
1145 0         0
1146 0 0       0 eval "require $further_class;";
1147             die "Can't find custom build class '$further_class'" if $@;
1148 0         0
1149             copy_package($further_class, 'true');
1150 0         0
1151             sync_interface($further_class);
1152 0         0
1153 0         0 _mb_required('0.28');
1154             return;
1155             }
1156              
1157             sub subclass {
1158 0     0 1 0 # '$class->' will enable the further subclassing of custom subclass
1159 0         0 sync_interface($class->subclass(@_));
1160             return;
1161             }
1162              
1163 1     1 1 3 sub create_build_script {
1164 1         34 get_builder();
1165 1         640016 $object->create_build_script;
1166             return $object;
1167             }
1168              
1169             # Required to get a builder for later use.
1170             sub get_builder {
1171 1 50   1 1 5  
  0         0  
1172 1         19 if ( $mb_required < 0.07 ) { $mb_required = '0.07'; }
1173             build_requires( 'Module::Build', $mb_required );
1174 1 50       5  
1175 1         6 if ( $mb_required > 0.2999 ) {
1176             configure_requires( 'Module::Build', $mb_required );
1177             }
1178 1 50       4  
1179 1         20 unless ( defined $object ) {
1180 1         119848 $object = $class->new(%ARGS);
1181             $object_created = 1;
1182             }
1183 1         22  
1184 0         0 foreach my $type (@install_types) {
1185             $object->add_build_element($type);
1186             }
1187 1         8  
1188             return $object;
1189             } ## end sub get_builder
1190              
1191              
1192             sub sync_interface {
1193 0     0 0 0 # subclass needs be already 'required', as it will be introspected
1194             my $subclass = shift;
1195            
1196 0         0 # Properties of current builder class
1197             my @current_all_properties = $class->valid_properties;
1198            
1199 0         0 # Hashed variant for convenient checking of presense
  0         0  
1200             my %current_all_properties = map { $_ => '' } @current_all_properties;
1201            
1202            
1203 0         0 # Properties of subclass
1204 0         0 my @all_properties = $subclass->valid_properties;
  0         0  
1205 0         0 my %array_properties = map { $_ => '' } $subclass->array_properties;
  0         0  
1206             my %hash_properties = map { $_ => '' } $subclass->hash_properties;
1207 0         0
1208             $class = $subclass;
1209 0         0
1210             foreach my $property (@all_properties) {
1211 0 0       0 # Skipping already presented properties
1212             next if defined $current_all_properties{$property};
1213 0 0       0
    0          
1214 0         0 if (defined $hash_properties{$property}) {
1215             additional_hash($property)
1216 0         0 } elsif (defined $array_properties{$property}) {
1217             additional_array($property)
1218 0         0 } else {
1219             additional_flag($property)
1220             }
1221             }
1222             }
1223              
1224              
1225 0     0 0 0 sub additional {
1226 0 0       0 my ($additional_type, $additional_name) = @_;
1227 0         0 if (not defined $additional_name) {
1228             croak 'additional requires a name.';
1229             }
1230 0 0       0
1231 0         0 unless($class->valid_property($additional_name)) {
1232             croak "Property '$additional_name' not found in $class";
1233             }
1234 0 0       0
    0          
    0          
1235 0         0 if ( 'array' eq lc $additional_type ) {
1236             $ARRAY{$additional_name} = 0.07;
1237 0         0 } elsif ( 'hash' eq lc $additional_type ) {
1238             $HASH{$additional_name} = [ 0.07, 0 ];
1239 0         0 } elsif ( 'flag' eq lc $additional_type ) {
1240             $FLAGS{$additional_name} = [ 0.07, 0 ];
1241 0         0 } else {
1242             croak 'additional requires two parameters: a type (array, hash, or flag) and a name.';
1243             }
1244 3     3   29
  3         6  
  3         743  
1245             no strict 'refs';
1246 0         0
1247             my $symbol = "${export_to}::$additional_name";
1248            
1249 0         0 # Create a stub in the caller package
  0         0  
1250             \&{$symbol};
1251             }
1252              
1253 0     0 1 0 sub additional_array {
1254 0 0       0 my $additional_name = shift;
1255 0         0 croak 'additional_array needs a name to define' if not defined $additional_name;
1256             additional('array', $additional_name);
1257             }
1258              
1259 0     0 1 0 sub additional_flag {
1260 0 0       0 my $additional_name = shift;
1261 0         0 croak 'additional_flag needs a name to define' if not defined $additional_name;
1262             additional('flag', $additional_name);
1263             }
1264              
1265 0     0 1 0 sub additional_hash {
1266 0 0       0 my $additional_name = shift;
1267 0         0 croak 'additional_hash needs a name to define' if not defined $additional_name;
1268             additional('hash', $additional_name);
1269             }
1270              
1271 0     0   0 sub _debug_print {
1272 0         0 require Data::Dumper;
1273             my $d = Data::Dumper->new( [ \%ARGS, \$mb_required ],
1274 0         0 [qw(*ARGS *mb_required)] );
1275 0         0 print $d->Indent(1)->Dump();
1276             return;
1277             }
1278              
1279             1;