File Coverage

blib/lib/Module/Build/Compat.pm
Criterion Covered Total %
statement 132 204 64.7
branch 42 100 42.0
condition 11 27 40.7
subroutine 18 24 75.0
pod 3 9 33.3
total 206 364 56.5


line stmt bran cond sub pod time code
1             package Module::Build::Compat;
2              
3 28     28   117089 use strict;
  17         117  
  17         948  
4 17     17   138 use warnings;
  17         38  
  17         1414  
5             our $VERSION = '0.42_33';
6              
7 17     17   267 use File::Basename ();
  17         114  
  17         636  
8 17     17   153 use File::Spec;
  17         99  
  17         721  
9 17     17   203 use Config;
  17         242  
  17         1231  
10 17     17   127 use Module::Build;
  17         36  
  17         987  
11 17     17   184 use Module::Metadata;
  17         35  
  17         533  
12 17     17   471 use version;
  17         35  
  17         317  
13 17     17   2404 use Data::Dumper;
  17         35  
  17         63581  
14              
15             my %convert_installdirs = (
16             PERL => 'core',
17             SITE => 'site',
18             VENDOR => 'vendor',
19             );
20              
21             my %makefile_to_build =
22             (
23             TEST_VERBOSE => 'verbose',
24             VERBINST => 'verbose',
25             INC => sub { map {(extra_compiler_flags => $_)} Module::Build->split_like_shell(shift) },
26             POLLUTE => sub { (extra_compiler_flags => '-DPERL_POLLUTE') },
27             INSTALLDIRS => sub { (installdirs => $convert_installdirs{uc shift()}) },
28             LIB => sub {
29             my $lib = shift;
30             my %config = (
31             installprivlib => $lib,
32             installsitelib => $lib,
33             installarchlib => "$lib/$Config{archname}",
34             installsitearch => "$lib/$Config{archname}"
35             );
36             return map { (config => "$_=$config{$_}") } sort keys %config;
37             },
38              
39             # Convert INSTALLVENDORLIB and friends.
40             (
41             map {
42             my $name = $_;
43             $name => sub {
44             my @ret = (config => lc($name) . "=" . shift );
45             print STDERR "# Converted to @ret\n";
46              
47             return @ret;
48             }
49             } qw(
50             INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH
51             INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB
52             INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN
53             INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT
54             INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
55             INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
56             )
57             ),
58              
59             # Some names they have in common
60             map {$_, lc($_)} qw(DESTDIR PREFIX INSTALL_BASE UNINST),
61             );
62              
63             my %macro_to_build = %makefile_to_build;
64             # "LIB=foo make" is not the same as "perl Makefile.PL LIB=foo"
65             delete $macro_to_build{LIB};
66              
67             sub _merge_prereq {
68 22     22   88 my ($req, $breq) = @_;
69 22   50     155 $req ||= {};
70 22   50     156 $breq ||= {};
71              
72             # validate formats
73 22         172 for my $p ( $req, $breq ) {
74 44         354 for my $k (sort keys %$p) {
75 33 100       263 next if $k eq 'perl';
76              
77 25         107 my $v_obj = eval { version->new($p->{$k}) };
  25         329  
78 25 50       192 if ( ! defined $v_obj ) {
79 0         0 die "A prereq of the form '$p->{$k}' for '$k' is not supported by Module::Build::Compat ( use a simpler version like '0.05' or 'v1.4.25' )\n";
80             }
81              
82             # It seems like a lot of people trip over "0.1.2" stuff, so we help them here...
83 25 100       262 if ( $v_obj->is_qv ) {
84 1         15 my $proper_ver = $v_obj->numify;
85 1         467 warn "Dotted-decimal prereq '$p->{$k}' for '$k' is not portable - converting it to '$proper_ver'\n";
86 1         639 $p->{$k} = $proper_ver;
87             }
88             }
89             }
90             # merge
91 22         158 my $merge = { %$req };
92 22         122 for my $k ( keys %$breq ) {
93 16   100     224 my $v1 = $merge->{$k} || 0;
94 16         56 my $v2 = $breq->{$k};
95 16 100       216 $merge->{$k} = $v1 > $v2 ? $v1 : $v2;
96             }
97 22         243 return %$merge;
98             }
99              
100              
101             sub create_makefile_pl {
102 98     98 1 355076 my ($package, $type, $build, %args) = @_;
103              
104 98 50       2964 die "Don't know how to build Makefile.PL of type '$type'"
105             unless $type =~ /^(small|passthrough|traditional)$/;
106              
107 98 100       911 if ($type eq 'passthrough') {
108 42         1437 $build->log_warn(<<"HERE");
109              
110             IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and
111             may be removed in a future version of Module::Build in favor of the
112             'configure_requires' property. See Module::Build::Compat
113             documentation for details.
114              
115             HERE
116             }
117              
118 98         35870 my $fh;
119 98 50       721 if ($args{fh}) {
120 0         0 $fh = $args{fh};
121             } else {
122 98   50     2329 $args{file} ||= 'Makefile.PL';
123 98         788 local $build->{properties}{quiet} = 1;
124 98         2945 $build->delete_filetree($args{file});
125 98 50       10298 open($fh, '>', "$args{file}") or die "Can't write $args{file}: $!";
126             }
127              
128 98         894 print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";
  98         1463  
129              
130             # Minimum perl version should be specified as "require 5.XXXXXX" in
131             # Makefile.PL
132 98         2662 my $requires = $build->requires;
133 98 100       821 if ( my $minimum_perl = $requires->{perl} ) {
134 27         2434 my $min_ver = version->new($minimum_perl)->numify;
135 27         253 print {$fh} "require $min_ver;\n";
  27         451  
136             }
137              
138             # If a *bundled* custom subclass is being used, make sure we add its
139             # directory to @INC. Also, lib.pm always needs paths in Unix format.
140 98         409 my $subclass_load = '';
141 98 100       629 if (ref($build) ne "Module::Build") {
142 22         742 my $subclass_dir = $package->subclass_dir($build);
143              
144 22 100       3031 if (File::Spec->file_name_is_absolute($subclass_dir)) {
145 10         405 my $base_dir = $build->base_dir;
146              
147 10 50       290 if ($build->dir_contains($base_dir, $subclass_dir)) {
148 10         1870 $subclass_dir = File::Spec->abs2rel($subclass_dir, $base_dir);
149 10         170 $subclass_dir = $package->unixify_dir($subclass_dir);
150 10         120 $subclass_load = "use lib '$subclass_dir';";
151             }
152             # Otherwise, leave it the empty string
153              
154             } else {
155 12         282 $subclass_dir = $package->unixify_dir($subclass_dir);
156 12         174 $subclass_load = "use lib '$subclass_dir';";
157             }
158             }
159              
160 98 100       1202 if ($type eq 'small') {
    100          
    50          
161 34         105 printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
  34         1076  
162             use Module::Build::Compat 0.02;
163             %s
164             Module::Build::Compat->run_build_pl(args => \@ARGV);
165             require %s;
166             Module::Build::Compat->write_makefile(build_class => '%s');
167             EOF
168              
169             } elsif ($type eq 'passthrough') {
170 42         246 printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
  42         1026  
171              
172             unless (eval "use Module::Build::Compat 0.02; 1" ) {
173             print "This module requires Module::Build to install itself.\n";
174              
175             require ExtUtils::MakeMaker;
176             my $yn = ExtUtils::MakeMaker::prompt
177             (' Install Module::Build now from CPAN?', 'y');
178              
179             unless ($yn =~ /^y/i) {
180             die " *** Cannot install without Module::Build. Exiting ...\n";
181             }
182              
183             require Cwd;
184             require File::Spec;
185             require CPAN;
186              
187             # Save this 'cause CPAN will chdir all over the place.
188             my $cwd = Cwd::cwd();
189              
190             CPAN::Shell->install('Module::Build::Compat');
191             CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
192             or die "Couldn't install Module::Build, giving up.\n";
193              
194             chdir $cwd or die "Cannot chdir() back to $cwd: $!";
195             }
196             eval "use Module::Build::Compat 0.02; 1" or die $@;
197             %s
198             Module::Build::Compat->run_build_pl(args => \@ARGV);
199             my $build_script = 'Build';
200             $build_script .= '.com' if $^O eq 'VMS';
201             exit(0) unless(-e $build_script); # cpantesters convention
202             require %s;
203             Module::Build::Compat->write_makefile(build_class => '%s');
204             EOF
205              
206             } elsif ($type eq 'traditional') {
207              
208 22         334 my (%MM_Args, %prereq);
209 22 50   11   4231 if (eval "use Tie::IxHash 1.2; 1") {
  11         4180  
  0            
  0            
210 0         0 tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
211 0         0 tie %prereq, 'Tie::IxHash'; # Don't care if it fails here
212             }
213              
214 22 50       589 my %name = ($build->module_name
215             ? (NAME => $build->module_name)
216             : (DISTNAME => $build->dist_name));
217              
218 22 50       371 my %version = ($build->dist_version_from
219             ? (VERSION_FROM => $build->dist_version_from)
220             : (VERSION => $build->dist_version)
221             );
222 22         251 %MM_Args = (%name, %version);
223              
224 22         169 %prereq = _merge_prereq( $build->requires, $build->build_requires );
225 22         121 %prereq = map {$_, $prereq{$_}} sort keys %prereq;
  25         170  
226              
227 22         66 delete $prereq{perl};
228 22         149 $MM_Args{PREREQ_PM} = \%prereq;
229              
230 22 50       341 $MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs;
231              
232 22 50       476 $MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
  22         619  
233              
234 22   100     162 $MM_Args{PL_FILES} = $build->PL_files || {};
235              
236 22 100       412 if ($build->recursive_test_files) {
237 2         44 $MM_Args{test} = { TESTS => join q{ }, $package->_test_globs($build) };
238             }
239              
240 22         255 local $Data::Dumper::Terse = 1;
241 22         712 my $args = Data::Dumper::Dumper(\%MM_Args);
242 22         6098 $args =~ s/\{(.*)\}/($1)/s;
243              
244 22         1573 print $fh <<"EOF";
245             use ExtUtils::MakeMaker;
246             WriteMakefile
247             $args;
248             EOF
249             }
250             }
251              
252             sub _test_globs {
253 2     2   18 my ($self, $build) = @_;
254              
255 4         132 return map { File::Spec->catfile($_, '*.t') }
256 2     8   24 @{$build->rscan_dir('t', sub { -d $File::Find::name })};
  2         86  
  8         1176  
257             }
258              
259             sub subclass_dir {
260 22     22 0 243 my ($self, $build) = @_;
261              
262 22   66     968 return (Module::Metadata->find_module_dir_by_name(ref $build)
263             || File::Spec->catdir($build->config_dir, 'lib'));
264             }
265              
266             sub unixify_dir {
267 22     22 0 149 my ($self, $path) = @_;
268 22         394 return join '/', File::Spec->splitdir($path);
269             }
270              
271             sub makefile_to_build_args {
272 0     0 0 0 my $class = shift;
273 0         0 my @out;
274 0         0 foreach my $arg (@_) {
275 0 0       0 next if $arg eq '';
276              
277 0 0       0 my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) :
278             die "Malformed argument '$arg'");
279              
280             # Do tilde-expansion if it looks like a tilde prefixed path
281 0 0       0 ( $val ) = Module::Build->_detildefy( $val ) if $val =~ /^~/;
282              
283 0 0       0 if (exists $makefile_to_build{$key}) {
    0          
284 0         0 my $trans = $makefile_to_build{$key};
285 0 0       0 push @out, $class->_argvify( ref($trans) ? $trans->($val) : ($trans => $val) );
286             } elsif (exists $Config{lc($key)}) {
287 0         0 push @out, $class->_argvify( config => lc($key) . "=$val" );
288             } else {
289             # Assume M::B can handle it in lowercase form
290 0         0 push @out, $class->_argvify("\L$key" => $val);
291             }
292             }
293 0         0 return @out;
294             }
295              
296             sub _argvify {
297 0     0   0 my ($self, @pairs) = @_;
298 0         0 my @out;
299 0         0 while (@pairs) {
300 0         0 my ($k, $v) = splice @pairs, 0, 2;
301 0         0 push @out, ("--$k", $v);
302             }
303 0         0 return @out;
304             }
305              
306             sub makefile_to_build_macros {
307 0     0 0 0 my @out;
308             my %config; # must accumulate and return as a hashref
309 0         0 foreach my $macro (sort keys %macro_to_build) {
310 0         0 my $trans = $macro_to_build{$macro};
311             # On some platforms (e.g. Cygwin with 'make'), the mere presence
312             # of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined.
313             # Therefore we check length() too.
314 0 0 0     0 next unless exists $ENV{$macro} && length $ENV{$macro};
315 0         0 my $val = $ENV{$macro};
316 0 0       0 my @args = ref($trans) ? $trans->($val) : ($trans => $val);
317 0         0 while (@args) {
318 0         0 my ($k, $v) = splice(@args, 0, 2);
319 0 0       0 if ( $k eq 'config' ) {
320 0 0       0 if ( $v =~ /^([^=]+)=(.*)$/ ) {
321 0         0 $config{$1} = $2;
322             }
323             else {
324 0         0 warn "Couldn't parse config '$v'\n";
325             }
326             }
327             else {
328 0         0 push @out, ($k => $v);
329             }
330             }
331             }
332 0 0       0 push @out, (config => \%config) if %config;
333 0         0 return @out;
334             }
335              
336             sub run_build_pl {
337 0     0 1 0 my ($pack, %in) = @_;
338 0   0     0 $in{script} ||= 'Build.PL';
339 0 0       0 my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : ();
  0         0  
340 0         0 print "# running $in{script} @args\n";
341 0 0       0 Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!";
342             }
343              
344             sub fake_makefile {
345 7     7 0 20608 my ($self, %args) = @_;
346 7 50       189 unless (exists $args{build_class}) {
347 7         378 warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
348 7         119 $args{build_class} = 'Module::Build';
349             }
350 7         77 my $class = $args{build_class};
351              
352 7         448 my $perl = $class->find_perl_interpreter;
353              
354             # VMS MMS/MMK need to use MCR to run the Perl image.
355 7 50       91 $perl = 'MCR ' . $perl if $self->_is_vms_mms;
356              
357 7 50       455 my $noop = ($class->is_windowsish ? 'rem>nul' :
    50          
358             $self->_is_vms_mms ? 'Continue' :
359             'true');
360              
361 7 50       273 my $filetype = $class->is_vmsish ? '.COM' : '';
362              
363 7         196 my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
364 7         294 my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
365 7 50       35 $unlink =~ s/\$/\$\$/g unless $class->is_vmsish;
366              
367 7         826 my $maketext = join '', map { "$_=\n" } sort keys %macro_to_build;
  189         476  
368              
369             $maketext .= ($^O eq 'os2' ? "SHELL = sh\n\n"
370 7 50 33     161 : $^O eq 'MSWin32' && $Config{make} =~ /gmake/
    50          
371             ? "SHELL = $ENV{COMSPEC}\n\n" : "\n\n");
372              
373 7         84 $maketext .= <<"EOF";
374             all : force_do_it
375             $perl $Build
376             realclean : force_do_it
377             $perl $Build realclean
378             $unlink
379             distclean : force_do_it
380             $perl $Build distclean
381             $unlink
382              
383              
384             force_do_it :
385             @ $noop
386             EOF
387              
388 7         154 foreach my $action ($class->known_actions) {
389 266 100       714 next if $action =~ /^(all|distclean|realclean|force_do_it)$/; # Don't double-define
390 252         735 $maketext .= <<"EOF";
391             $action : force_do_it
392             $perl $Build $action
393             EOF
394             }
395              
396 7 50       77 if ($self->_is_vms_mms) {
397             # Roll our own .EXPORT as MMS/MMK don't honor that directive.
398 0         0 $maketext .= "\n.FIRST\n\t\@ $noop\n";
399 0         0 for my $macro (sort keys %macro_to_build) {
400 0         0 $maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n";
401             }
402 0         0 $maketext .= "\n";
403             }
404             else {
405 7         350 $maketext .= "\n.EXPORT : " . join(' ', sort keys %macro_to_build) . "\n\n";
406             }
407              
408 7         56 return $maketext;
409             }
410              
411             sub fake_prereqs {
412 0     0 0 0 my $file = File::Spec->catfile('_build', 'prereqs');
413 0 0       0 open(my $fh, '<', "$file") or die "Can't read $file: $!";
414 0         0 my $prereqs = eval do {local $/; <$fh>};
  0         0  
  0         0  
415 0         0 close $fh;
416              
417 0         0 my %merged = _merge_prereq( $prereqs->{requires}, $prereqs->{build_requires} );
418 0         0 my @prereq;
419 0         0 foreach (sort keys %merged) {
420 0 0       0 next if $_ eq 'perl';
421 0         0 push @prereq, "$_=>q[$merged{$_}]";
422             }
423 0 0       0 return unless @prereq;
424 0         0 return "# PREREQ_PM => { " . join(", ", @prereq) . " }\n\n";
425             }
426              
427              
428             sub write_makefile {
429 0     0 1 0 my ($pack, %in) = @_;
430              
431 0 0       0 unless (exists $in{build_class}) {
432 0         0 warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
433 0         0 $in{build_class} = 'Module::Build';
434             }
435 0         0 my $class = $in{build_class};
436 0 0 0     0 $in{makefile} ||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile';
437              
438 0 0       0 open MAKE, "> $in{makefile}" or die "Cannot write $in{makefile}: $!";
439 0         0 print MAKE $pack->fake_prereqs;
440 0         0 print MAKE $pack->fake_makefile(%in);
441 0         0 close MAKE;
442             }
443              
444             sub _is_vms_mms {
445 21   33 21   462 return Module::Build->is_vmsish && ($Config{make} =~ m/MM[SK]/i);
446             }
447              
448             1;
449             __END__