File Coverage

lib/ExtUtils/MM_Any.pm
Criterion Covered Total %
statement 641 785 81.6
branch 225 346 65.0
condition 144 302 47.6
subroutine 85 102 83.3
pod 69 73 94.5
total 1164 1608 72.3


line stmt bran cond sub pod time code
1             package ExtUtils::MM_Any;
2              
3 52     52   1850 use strict;
  52         146  
  52         1813  
4 52     52   312 use warnings;
  52         121  
  52         2991  
5             our $VERSION = '7.66';
6             $VERSION =~ tr/_//d;
7              
8 52     52   355 use Carp;
  52         123  
  52         3116  
9 52     52   379 use File::Spec;
  52         164  
  52         1335  
10 52     52   282 use File::Basename;
  52         128  
  52         3743  
11 52     52   2628 BEGIN { our @ISA = qw(File::Spec); }
12              
13             # We need $Verbose
14 52     52   2094 use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562);
  52         152  
  52         6289  
15              
16 52     52   433 use ExtUtils::MakeMaker::Config;
  52         121  
  52         514  
17              
18              
19             # So we don't have to keep calling the methods over and over again,
20             # we have these globals to cache the values. Faster and shrtr.
21             my $Curdir = __PACKAGE__->curdir;
22             #my $Updir = __PACKAGE__->updir;
23              
24             my $METASPEC_URL = 'https://metacpan.org/pod/CPAN::Meta::Spec';
25             my $METASPEC_V = 2;
26              
27             =head1 NAME
28              
29             ExtUtils::MM_Any - Platform-agnostic MM methods
30              
31             =head1 SYNOPSIS
32              
33             FOR INTERNAL USE ONLY!
34              
35             package ExtUtils::MM_SomeOS;
36              
37             # Temporarily, you have to subclass both. Put MM_Any first.
38             require ExtUtils::MM_Any;
39             require ExtUtils::MM_Unix;
40             @ISA = qw(ExtUtils::MM_Any ExtUtils::Unix);
41              
42             =head1 DESCRIPTION
43              
44             B<FOR INTERNAL USE ONLY!>
45              
46             ExtUtils::MM_Any is a superclass for the ExtUtils::MM_* set of
47             modules. It contains methods which are either inherently
48             cross-platform or are written in a cross-platform manner.
49              
50             Subclass off of ExtUtils::MM_Any I<and> L<ExtUtils::MM_Unix>. This is a
51             temporary solution.
52              
53             B<THIS MAY BE TEMPORARY!>
54              
55              
56             =head1 METHODS
57              
58             Any methods marked I<Abstract> must be implemented by subclasses.
59              
60              
61             =head2 Cross-platform helper methods
62              
63             These are methods which help writing cross-platform code.
64              
65              
66              
67             =head3 os_flavor I<Abstract>
68              
69             my @os_flavor = $mm->os_flavor;
70              
71             @os_flavor is the style of operating system this is, usually
72             corresponding to the MM_*.pm file we're using.
73              
74             The first element of @os_flavor is the major family (ie. Unix,
75             Windows, VMS, OS/2, etc...) and the rest are sub families.
76              
77             Some examples:
78              
79             Cygwin98 ('Unix', 'Cygwin', 'Cygwin9x')
80             Windows ('Win32')
81             Win98 ('Win32', 'Win9x')
82             Linux ('Unix', 'Linux')
83             MacOS X ('Unix', 'Darwin', 'MacOS', 'MacOS X')
84             OS/2 ('OS/2')
85              
86             This is used to write code for styles of operating system.
87             See os_flavor_is() for use.
88              
89              
90             =head3 os_flavor_is
91              
92             my $is_this_flavor = $mm->os_flavor_is($this_flavor);
93             my $is_this_flavor = $mm->os_flavor_is(@one_of_these_flavors);
94              
95             Checks to see if the current operating system is one of the given flavors.
96              
97             This is useful for code like:
98              
99             if( $mm->os_flavor_is('Unix') ) {
100             $out = `foo 2>&1`;
101             }
102             else {
103             $out = `foo`;
104             }
105              
106             =cut
107              
108             sub os_flavor_is {
109 222     222 1 1315 my $self = shift;
110 222         3020 my %flavors = map { ($_ => 1) } $self->os_flavor;
  222         2511  
111 222 100       983 return (grep { $flavors{$_} } @_) ? 1 : 0;
  222         2835  
112             }
113              
114              
115             =head3 can_load_xs
116              
117             my $can_load_xs = $self->can_load_xs;
118              
119             Returns true if we have the ability to load XS.
120              
121             This is important because miniperl, used to build XS modules in the
122             core, can not load XS.
123              
124             =cut
125              
126             sub can_load_xs {
127 0 0   0 1 0 return defined &DynaLoader::boot_DynaLoader ? 1 : 0;
128             }
129              
130              
131             =head3 can_run
132              
133             use ExtUtils::MM;
134             my $runnable = MM->can_run($Config{make});
135              
136             If called in a scalar context it will return the full path to the binary
137             you asked for if it was found, or C<undef> if it was not.
138              
139             If called in a list context, it will return a list of the full paths to instances
140             of the binary where found in C<PATH>, or an empty list if it was not found.
141              
142             Copied from L<IPC::Cmd|IPC::Cmd/"$path = can_run( PROGRAM );">, but modified into
143             a method (and removed C<$INSTANCES> capability).
144              
145             =cut
146              
147             sub can_run {
148 9     9 1 212753 my ($self, $command) = @_;
149              
150             # a lot of VMS executables have a symbol defined
151             # check those first
152 9 50       56 if ( $^O eq 'VMS' ) {
153 0         0 require VMS::DCLsym;
154 0         0 my $syms = VMS::DCLsym->new;
155 0 0       0 return $command if scalar $syms->getsym( uc $command );
156             }
157              
158 9         23 my @possibles;
159              
160 9 50       141 if( File::Spec->file_name_is_absolute($command) ) {
161 0         0 return $self->maybe_command($command);
162              
163             } else {
164 9         229 for my $dir (
165             File::Spec->path,
166             File::Spec->curdir
167             ) {
168 90 100 66     1287 next if ! $dir || ! -d $dir;
169 81 50       339 my $abs = File::Spec->catfile($self->os_flavor_is('Win32') ? Win32::GetShortPathName( $dir ) : $dir, $command);
170 81 50       344 push @possibles, $abs if $abs = $self->maybe_command($abs);
171             }
172             }
173 9 50       63 return @possibles if wantarray;
174 9         40 return shift @possibles;
175             }
176              
177              
178             =head3 can_redirect_error
179              
180             $useredirect = MM->can_redirect_error;
181              
182             True if on an OS where qx operator (or backticks) can redirect C<STDERR>
183             onto C<STDOUT>.
184              
185             =cut
186              
187             sub can_redirect_error {
188 137     137 1 55677360 my $self = shift;
189 137 0 0     2313 $self->os_flavor_is('Unix')
      33        
190             or ($self->os_flavor_is('Win32') and !$self->os_flavor_is('Win9x'))
191             or $self->os_flavor_is('OS/2')
192             }
193              
194              
195             =head3 is_make_type
196              
197             my $is_dmake = $self->is_make_type('dmake');
198              
199             Returns true if C<< $self->make >> is the given type; possibilities are:
200              
201             gmake GNU make
202             dmake
203             nmake
204             bsdmake BSD pmake-derived
205              
206             =cut
207              
208             my %maketype2true;
209             # undocumented - so t/cd.t can still do its thing
210 2     2   1376 sub _clear_maketype_cache { %maketype2true = () }
211              
212             sub is_make_type {
213 583     583 1 3060 my($self, $type) = @_;
214 583 100       5014 return $maketype2true{$type} if defined $maketype2true{$type};
215 35         736 (undef, undef, my $make_basename) = $self->splitpath($self->make);
216 35 100       855 return $maketype2true{$type} = 1
217             if $make_basename =~ /\b$type\b/i; # executable's filename
218 34 100       477 return $maketype2true{$type} = 0
219             if $make_basename =~ /\b[gdn]make\b/i; # Never fall through for dmake/nmake/gmake
220             # now have to run with "-v" and guess
221 33 50       625 my $redirect = $self->can_redirect_error ? '2>&1' : '';
222 33   33     190 my $make = $self->make || $self->{MAKE};
223 33         196403 my $minus_v = `"$make" -v $redirect`;
224 33 100 66     1820 return $maketype2true{$type} = 1
225             if $type eq 'gmake' and $minus_v =~ /GNU make/i;
226 31 50 33     591 return $maketype2true{$type} = 1
227             if $type eq 'bsdmake'
228             and $minus_v =~ /^usage: make \[-BeikNnqrstWwX\]/im;
229 31         2414 $maketype2true{$type} = 0; # it wasn't whatever you asked
230             }
231              
232              
233             =head3 can_dep_space
234              
235             my $can_dep_space = $self->can_dep_space;
236              
237             Returns true if C<make> can handle (probably by quoting)
238             dependencies that contain a space. Currently known true for GNU make,
239             false for BSD pmake derivative.
240              
241             =cut
242              
243             my $cached_dep_space;
244             sub can_dep_space {
245 2     2 1 42 my $self = shift;
246 2 50       10 return $cached_dep_space if defined $cached_dep_space;
247 2 50       21 return $cached_dep_space = 1 if $self->is_make_type('gmake');
248 0 0       0 return $cached_dep_space = 0 if $self->is_make_type('dmake'); # only on W32
249 0 0       0 return $cached_dep_space = 0 if $self->is_make_type('bsdmake');
250 0         0 return $cached_dep_space = 0; # assume no
251             }
252              
253              
254             =head3 quote_dep
255              
256             $text = $mm->quote_dep($text);
257              
258             Method that protects Makefile single-value constants (mainly filenames),
259             so that make will still treat them as single values even if they
260             inconveniently have spaces in. If the make program being used cannot
261             achieve such protection and the given text would need it, throws an
262             exception.
263              
264             =cut
265              
266             sub quote_dep {
267 429     429 1 1396 my ($self, $arg) = @_;
268 429 50 33     2007 die <<EOF if $arg =~ / / and not $self->can_dep_space;
269             Tried to use make dependency with space for make that can't:
270             '$arg'
271             EOF
272 429         1095 $arg =~ s/( )/\\$1/g; # how GNU make does it
273 429         1874 return $arg;
274             }
275              
276              
277             =head3 split_command
278              
279             my @cmds = $MM->split_command($cmd, @args);
280              
281             Most OS have a maximum command length they can execute at once. Large
282             modules can easily generate commands well past that limit. Its
283             necessary to split long commands up into a series of shorter commands.
284              
285             C<split_command> will return a series of @cmds each processing part of
286             the args. Collectively they will process all the arguments. Each
287             individual line in @cmds will not be longer than the
288             $self->max_exec_len being careful to take into account macro expansion.
289              
290             $cmd should include any switches and repeated initial arguments.
291              
292             If no @args are given, no @cmds will be returned.
293              
294             Pairs of arguments will always be preserved in a single command, this
295             is a heuristic for things like pm_to_blib and pod2man which work on
296             pairs of arguments. This makes things like this safe:
297              
298             $self->split_command($cmd, %pod2man);
299              
300              
301             =cut
302              
303             sub split_command {
304 1075     1075 1 31826 my($self, $cmd, @args) = @_;
305              
306 1075         2062 my @cmds = ();
307 1075 100       3173 return(@cmds) unless @args;
308              
309             # If the command was given as a here-doc, there's probably a trailing
310             # newline.
311 760         1716 chomp $cmd;
312              
313             # set aside 30% for macro expansion.
314 760         3648 my $len_left = int($self->max_exec_len * 0.70);
315 760         2460 $len_left -= length $self->_expand_macros($cmd);
316              
317 760         1588 do {
318 765         1943 my $arg_str = '';
319 765         1357 my @next_args;
320 765         3013 while( @next_args = splice(@args, 0, 2) ) {
321             # Two at a time to preserve pairs.
322 3065         7343 my $next_arg_str = "\t ". join ' ', @next_args, "\n";
323              
324 3065 100       6633 if( !length $arg_str ) {
    100          
325 765         2376 $arg_str .= $next_arg_str
326             }
327             elsif( length($arg_str) + length($next_arg_str) > $len_left ) {
328 5         11 unshift @args, @next_args;
329 5         8 last;
330             }
331             else {
332 2295         5597 $arg_str .= $next_arg_str;
333             }
334             }
335 765         1679 chop $arg_str;
336              
337 765         3584 push @cmds, $self->escape_newlines("$cmd \n$arg_str");
338             } while @args;
339              
340 760         4049 return @cmds;
341             }
342              
343              
344             sub _expand_macros {
345 1070     1070   3192 my($self, $cmd) = @_;
346              
347 1070         7880 $cmd =~ s{\$\((\w+)\)}{
348 1057 100       6133 defined $self->{$1} ? $self->{$1} : "\$($1)"
349             }e;
350 1070         5182 return $cmd;
351             }
352              
353              
354             =head3 make_type
355              
356             Returns a suitable string describing the type of makefile being written.
357              
358             =cut
359              
360             # override if this isn't suitable!
361 93     93 1 1833 sub make_type { return 'Unix-style'; }
362              
363              
364             =head3 stashmeta
365              
366             my @recipelines = $MM->stashmeta($text, $file);
367              
368             Generates a set of C<@recipelines> which will result in the literal
369             C<$text> ending up in literal C<$file> when the recipe is executed. Call
370             it once, with all the text you want in C<$file>. Make macros will not
371             be expanded, so the locations will be fixed at configure-time, not
372             at build-time.
373              
374             =cut
375              
376             sub stashmeta {
377 417     417 1 945062 my($self, $text, $file) = @_;
378 417         3981 $self->echo($text, $file, { allow_variables => 0, append => 0 });
379             }
380              
381              
382             =head3 echo
383              
384             my @commands = $MM->echo($text);
385             my @commands = $MM->echo($text, $file);
386             my @commands = $MM->echo($text, $file, \%opts);
387              
388             Generates a set of @commands which print the $text to a $file.
389              
390             If $file is not given, output goes to STDOUT.
391              
392             If $opts{append} is true the $file will be appended to rather than
393             overwritten. Default is to overwrite.
394              
395             If $opts{allow_variables} is true, make variables of the form
396             C<$(...)> will not be escaped. Other C<$> will. Default is to escape
397             all C<$>.
398              
399             Example of use:
400              
401             my $make = join '', map "\t$_\n", $MM->echo($text, $file);
402              
403             =cut
404              
405             sub echo {
406 425     425 1 64805 my($self, $text, $file, $opts) = @_;
407              
408             # Compatibility with old options
409 425 100       1643 if( !ref $opts ) {
410 6         14 my $append = $opts;
411 6   100     112 $opts = { append => $append || 0 };
412             }
413 425 100       1379 $opts->{allow_variables} = 0 unless defined $opts->{allow_variables};
414              
415 425         1342 my $ql_opts = { allow_variables => $opts->{allow_variables} };
416 425         3757 my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_, $ql_opts) }
  9058         19345  
417             split /\n/, $text;
418 425 50       2428 if( $file ) {
419 425 100       2005 my $redirect = $opts->{append} ? '>>' : '>';
420 425         1460 $cmds[0] .= " $redirect $file";
421 425         6145 $_ .= " >> $file" foreach @cmds[1..$#cmds];
422             }
423              
424 425         3756 return @cmds;
425             }
426              
427              
428             =head3 wraplist
429              
430             my $args = $mm->wraplist(@list);
431              
432             Takes an array of items and turns them into a well-formatted list of
433             arguments. In most cases this is simply something like:
434              
435             FOO \
436             BAR \
437             BAZ
438              
439             =cut
440              
441             sub wraplist {
442 1076     1076 1 1972 my $self = shift;
443 1076         3876 return join " \\\n\t", @_;
444             }
445              
446              
447             =head3 maketext_filter
448              
449             my $filter_make_text = $mm->maketext_filter($make_text);
450              
451             The text of the Makefile is run through this method before writing to
452             disk. It allows systems a chance to make portability fixes to the
453             Makefile.
454              
455             By default it does nothing.
456              
457             This method is protected and not intended to be called outside of
458             MakeMaker.
459              
460             =cut
461              
462 8174     8174 1 37474 sub maketext_filter { return $_[1] }
463              
464              
465             =head3 cd I<Abstract>
466              
467             my $subdir_cmd = $MM->cd($subdir, @cmds);
468              
469             This will generate a make fragment which runs the @cmds in the given
470             $dir. The rough equivalent to this, except cross platform.
471              
472             cd $subdir && $cmd
473              
474             Currently $dir can only go down one level. "foo" is fine. "foo/bar" is
475             not. "../foo" is right out.
476              
477             The resulting $subdir_cmd has no leading tab nor trailing newline. This
478             makes it easier to embed in a make string. For example.
479              
480             my $make = sprintf <<'CODE', $subdir_cmd;
481             foo :
482             $(ECHO) what
483             %s
484             $(ECHO) mouche
485             CODE
486              
487              
488             =head3 oneliner I<Abstract>
489              
490             my $oneliner = $MM->oneliner($perl_code);
491             my $oneliner = $MM->oneliner($perl_code, \@switches);
492              
493             This will generate a perl one-liner safe for the particular platform
494             you're on based on the given $perl_code and @switches (a -e is
495             assumed) suitable for using in a make target. It will use the proper
496             shell quoting and escapes.
497              
498             $(PERLRUN) will be used as perl.
499              
500             Any newlines in $perl_code will be escaped. Leading and trailing
501             newlines will be stripped. Makes this idiom much easier:
502              
503             my $code = $MM->oneliner(<<'CODE', [...switches...]);
504             some code here
505             another line here
506             CODE
507              
508             Usage might be something like:
509              
510             # an echo emulation
511             $oneliner = $MM->oneliner('print "Foo\n"');
512             $make = '$oneliner > somefile';
513              
514             Dollar signs in the $perl_code will be protected from make using the
515             C<quote_literal> method, unless they are recognised as being a make
516             variable, C<$(varname)>, in which case they will be left for make
517             to expand. Remember to quote make macros else it might be used as a
518             bareword. For example:
519              
520             # Assign the value of the $(VERSION_FROM) make macro to $vf.
521             $oneliner = $MM->oneliner('$vf = "$(VERSION_FROM)"');
522              
523             Its currently very simple and may be expanded sometime in the figure
524             to include more flexible code and switches.
525              
526              
527             =head3 quote_literal I<Abstract>
528              
529             my $safe_text = $MM->quote_literal($text);
530             my $safe_text = $MM->quote_literal($text, \%options);
531              
532             This will quote $text so it is interpreted literally in the shell.
533              
534             For example, on Unix this would escape any single-quotes in $text and
535             put single-quotes around the whole thing.
536              
537             If $options{allow_variables} is true it will leave C<'$(FOO)'> make
538             variables untouched. If false they will be escaped like any other
539             C<$>. Defaults to true.
540              
541             =head3 escape_dollarsigns
542              
543             my $escaped_text = $MM->escape_dollarsigns($text);
544              
545             Escapes stray C<$> so they are not interpreted as make variables.
546              
547             It lets by C<$(...)>.
548              
549             =cut
550              
551             sub escape_dollarsigns {
552 4183     4183 1 8430 my($self, $text) = @_;
553              
554             # Escape dollar signs which are not starting a variable
555 4183         12343 $text =~ s{\$ (?!\() }{\$\$}gx;
556              
557 4183         10298 return $text;
558             }
559              
560              
561             =head3 escape_all_dollarsigns
562              
563             my $escaped_text = $MM->escape_all_dollarsigns($text);
564              
565             Escapes all C<$> so they are not interpreted as make variables.
566              
567             =cut
568              
569             sub escape_all_dollarsigns {
570 8632     8632 1 14450 my($self, $text) = @_;
571              
572             # Escape dollar signs
573 8632         12579 $text =~ s{\$}{\$\$}gx;
574              
575 8632         16939 return $text;
576             }
577              
578              
579             =head3 escape_newlines I<Abstract>
580              
581             my $escaped_text = $MM->escape_newlines($text);
582              
583             Shell escapes newlines in $text.
584              
585              
586             =head3 max_exec_len I<Abstract>
587              
588             my $max_exec_len = $MM->max_exec_len;
589              
590             Calculates the maximum command size the OS can exec. Effectively,
591             this is the max size of a shell command line.
592              
593             =for _private
594             $self->{_MAX_EXEC_LEN} is set by this method, but only for testing purposes.
595              
596              
597             =head3 make
598              
599             my $make = $MM->make;
600              
601             Returns the make variant we're generating the Makefile for. This attempts
602             to do some normalization on the information from %Config or the user.
603              
604             =cut
605              
606             sub make {
607 69     69 1 243 my $self = shift;
608              
609 69         288 my $make = lc $self->{MAKE};
610              
611             # Truncate anything like foomake6 to just foomake.
612 69         242 $make =~ s/^(\w+make).*/$1/;
613              
614             # Turn gnumake into gmake.
615 69         315 $make =~ s/^gnu/g/;
616              
617 69         1983 return $make;
618             }
619              
620              
621             =head2 Targets
622              
623             These are methods which produce make targets.
624              
625              
626             =head3 all_target
627              
628             Generate the default target 'all'.
629              
630             =cut
631              
632             sub all_target {
633 0     0 1 0 my $self = shift;
634              
635 0         0 return <<'MAKE_EXT';
636             all :: pure_all
637             $(NOECHO) $(NOOP)
638             MAKE_EXT
639              
640             }
641              
642              
643             =head3 blibdirs_target
644              
645             my $make_frag = $mm->blibdirs_target;
646              
647             Creates the blibdirs target which creates all the directories we use
648             in blib/.
649              
650             The blibdirs.ts target is deprecated. Depend on blibdirs instead.
651              
652              
653             =cut
654              
655             sub _xs_list_basenames {
656 153     153   482 my ($self) = @_;
657 153         337 map { (my $b = $_) =~ s/\.xs$//; $b } sort keys %{ $self->{XS} };
  0         0  
  0         0  
  153         562  
658             }
659              
660             sub blibdirs_target {
661 153     153 1 484 my $self = shift;
662              
663 153         597 my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib
  1224         3533  
664             autodir archautodir
665             bin script
666             man1dir man3dir
667             );
668 153 50       761 if ($self->{XSMULTI}) {
669 0         0 for my $ext ($self->_xs_list_basenames) {
670 0         0 my ($v, $d, $f) = File::Spec->splitpath($ext);
671 0         0 my @d = File::Spec->splitdir($d);
672 0 0       0 shift @d if $d[0] eq 'lib';
673 0         0 push @dirs, $self->catdir('$(INST_ARCHLIB)', 'auto', @d, $f);
674             }
675             }
676              
677 153         452 my @exists = map { $_.'$(DFSEP).exists' } @dirs;
  1224         2937  
678              
679 153         1587 my $make = sprintf <<'MAKE', join(' ', @exists);
680             blibdirs : %s
681             $(NOECHO) $(NOOP)
682              
683             # Backwards compat with 6.18 through 6.25
684             blibdirs.ts : blibdirs
685             $(NOECHO) $(NOOP)
686              
687             MAKE
688              
689 153         2366 $make .= $self->dir_target(@dirs);
690              
691 153         872 return $make;
692             }
693              
694              
695             =head3 clean (o)
696              
697             Defines the clean target.
698              
699             =cut
700              
701             sub clean {
702             # --- Cleanup and Distribution Sections ---
703              
704 153     153 1 717 my($self, %attribs) = @_;
705 153         288 my @m;
706 153         915 push(@m, '
707             # Delete temporary files but do not touch installed files. We don\'t delete
708             # the Makefile here so a later make realclean still has a makefile to use.
709              
710             clean :: clean_subdirs
711             ');
712              
713 153         459 my @files = sort values %{$self->{XS}}; # .c files from *.xs files
  153         649  
714             push @files, map {
715 153         1403 my $file = $_;
  0         0  
716 0         0 map { $file.$_ } $self->{OBJ_EXT}, qw(.def _def.old .bs .bso .exp .base);
  0         0  
717             } $self->_xs_list_basenames;
718 153         848 my @dirs = qw(blib);
719              
720             # Normally these are all under blib but they might have been
721             # redefined.
722             # XXX normally this would be a good idea, but the Perl core sets
723             # INST_LIB = ../../lib rather than actually installing the files.
724             # So a "make clean" in an ext/ directory would blow away lib.
725             # Until the core is adjusted let's leave this out.
726             # push @dirs, qw($(INST_ARCHLIB) $(INST_LIB)
727             # $(INST_BIN) $(INST_SCRIPT)
728             # $(INST_MAN1DIR) $(INST_MAN3DIR)
729             # $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR)
730             # $(INST_STATIC) $(INST_DYNAMIC)
731             # );
732              
733              
734 153 50       645 if( $attribs{FILES} ) {
735             # Use @dirs because we don't know what's in here.
736             push @dirs, ref $attribs{FILES} ?
737 0         0 @{$attribs{FILES}} :
738 0 0       0 split /\s+/, $attribs{FILES} ;
739             }
740              
741 153         1907 push(@files, qw[$(MAKE_APERL_FILE)
742             MYMETA.json MYMETA.yml perlmain.c tmon.out mon.out so_locations
743             blibdirs.ts pm_to_blib pm_to_blib.ts
744             *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT)
745             $(BOOTSTRAP) $(BASEEXT).bso
746             $(BASEEXT).def lib$(BASEEXT).def
747             $(BASEEXT).exp $(BASEEXT).x
748             ]);
749              
750 153         718 push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
751 153         640 push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld'));
752              
753             # core files
754 153 50       829 if ($^O eq 'vos') {
755 0         0 push(@files, qw[perl*.kp]);
756             }
757             else {
758 153         560 push(@files, qw[core core.*perl.*.? *perl.core]);
759             }
760              
761 153         492 push(@files, map { "core." . "[0-9]"x$_ } (1..5));
  765         2463  
762              
763             # OS specific things to clean up. Use @dirs since we don't know
764             # what might be in here.
765 153         1401 push @dirs, $self->extra_clean_files;
766              
767             # Occasionally files are repeated several times from different sources
768 153         428 { my(%f) = map { ($_ => 1) } @files; @files = sort keys %f; }
  4743         15062  
  153         4112  
769 153         295 { my(%d) = map { ($_ => 1) } @dirs; @dirs = sort keys %d; }
  153         607  
  153         411  
  153         637  
  153         694  
770              
771 153         698 push @m, map "\t$_\n", $self->split_command('- $(RM_F)', @files);
772 153         862 push @m, map "\t$_\n", $self->split_command('- $(RM_RF)', @dirs);
773              
774             # Leave Makefile.old around for realclean
775 153         489 push @m, <<'MAKE';
776             $(NOECHO) $(RM_F) $(MAKEFILE_OLD)
777             - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
778             MAKE
779              
780 153 50       550 push(@m, "\t$attribs{POSTOP}\n") if $attribs{POSTOP};
781              
782 153         1677 join("", @m);
783             }
784              
785              
786             =head3 clean_subdirs_target
787              
788             my $make_frag = $MM->clean_subdirs_target;
789              
790             Returns the clean_subdirs target. This is used by the clean target to
791             call clean on any subdirectories which contain Makefiles.
792              
793             =cut
794              
795             sub clean_subdirs_target {
796 153     153 1 585 my($self) = shift;
797              
798             # No subdirectories, no cleaning.
799 153 100       287 return <<'NOOP_FRAG' unless @{$self->{DIR}};
  153         1119  
800             clean_subdirs :
801             $(NOECHO) $(NOOP)
802             NOOP_FRAG
803              
804              
805 56         191 my $clean = "clean_subdirs :\n";
806              
807 56         124 for my $dir (@{$self->{DIR}}) {
  56         307  
808 56         626 my $subclean = $self->oneliner(sprintf <<'CODE', $dir);
809             exit 0 unless chdir '%s'; system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)';
810             CODE
811              
812 56         499 $clean .= "\t$subclean\n";
813             }
814              
815 56         226 return $clean;
816             }
817              
818              
819             =head3 dir_target
820              
821             my $make_frag = $mm->dir_target(@directories);
822              
823             Generates targets to create the specified directories and set its
824             permission to PERM_DIR.
825              
826             Because depending on a directory to just ensure it exists doesn't work
827             too well (the modified time changes too often) dir_target() creates a
828             .exists file in the created directory. It is this you should depend on.
829             For portability purposes you should use the $(DIRFILESEP) macro rather
830             than a '/' to separate the directory from the file.
831              
832             yourdirectory$(DIRFILESEP).exists
833              
834             =cut
835              
836             sub dir_target {
837 153     153 1 861 my($self, @dirs) = @_;
838              
839 153         736 my $make = '';
840 153         728 foreach my $dir (@dirs) {
841 1224         4218 $make .= sprintf <<'MAKE', ($dir) x 4;
842             %s$(DFSEP).exists :: Makefile.PL
843             $(NOECHO) $(MKPATH) %s
844             $(NOECHO) $(CHMOD) $(PERM_DIR) %s
845             $(NOECHO) $(TOUCH) %s$(DFSEP).exists
846              
847             MAKE
848              
849             }
850              
851 153         1675 return $make;
852             }
853              
854              
855             =head3 distdir
856              
857             Defines the scratch directory target that will hold the distribution
858             before tar-ing (or shar-ing).
859              
860             =cut
861              
862             # For backwards compatibility.
863             *dist_dir = *distdir;
864              
865             sub distdir {
866 96     96 1 432 my($self) = shift;
867              
868 96 50       985 my $meta_target = $self->{NO_META} ? '' : 'distmeta';
869 96 50       603 my $sign_target = !$self->{SIGN} ? '' : 'distsignature';
870              
871 96         786 return sprintf <<'MAKE_FRAG', $meta_target, $sign_target;
872             create_distdir :
873             $(RM_RF) $(DISTVNAME)
874             $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
875             -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
876              
877             distdir : create_distdir %s %s
878             $(NOECHO) $(NOOP)
879              
880             MAKE_FRAG
881              
882             }
883              
884              
885             =head3 dist_test
886              
887             Defines a target that produces the distribution in the
888             scratch directory, and runs 'perl Makefile.PL; make ;make test' in that
889             subdirectory.
890              
891             =cut
892              
893             sub dist_test {
894 96     96 1 385 my($self) = shift;
895              
896 96         517 my $mpl_args = join " ", map qq["$_"], @ARGV;
897              
898 96         1074 my $test = $self->cd('$(DISTVNAME)',
899             '$(ABSPERLRUN) Makefile.PL '.$mpl_args,
900             '$(MAKE) $(PASTHRU)',
901             '$(MAKE) test $(PASTHRU)'
902             );
903              
904 96         792 return sprintf <<'MAKE_FRAG', $test;
905             disttest : distdir
906             %s
907              
908             MAKE_FRAG
909              
910              
911             }
912              
913              
914             =head3 xs_dlsyms_arg
915              
916             Returns command-line arg(s) to linker for file listing dlsyms to export.
917             Defaults to returning empty string, can be overridden by e.g. AIX.
918              
919             =cut
920              
921             sub xs_dlsyms_arg {
922 0     0 1 0 return '';
923             }
924              
925             =head3 xs_dlsyms_ext
926              
927             Returns file-extension for C<xs_make_dlsyms> method's output file,
928             including any "." character.
929              
930             =cut
931              
932             sub xs_dlsyms_ext {
933 0     0 1 0 die "Pure virtual method";
934             }
935              
936             =head3 xs_dlsyms_extra
937              
938             Returns any extra text to be prepended to the C<$extra> argument of
939             C<xs_make_dlsyms>.
940              
941             =cut
942              
943             sub xs_dlsyms_extra {
944 0     0 1 0 '';
945             }
946              
947             =head3 xs_dlsyms_iterator
948              
949             Iterates over necessary shared objects, calling C<xs_make_dlsyms> method
950             for each with appropriate arguments.
951              
952             =cut
953              
954             sub xs_dlsyms_iterator {
955 0     0 1 0 my ($self, $attribs) = @_;
956 0 0       0 if ($self->{XSMULTI}) {
957 0         0 my @m;
958 0         0 for my $ext ($self->_xs_list_basenames) {
959 0         0 my @parts = File::Spec->splitdir($ext);
960 0 0       0 shift @parts if $parts[0] eq 'lib';
961 0         0 my $name = join '::', @parts;
962 0         0 push @m, $self->xs_make_dlsyms(
963             $attribs,
964             $ext . $self->xs_dlsyms_ext,
965             "$ext.xs",
966             $name,
967             $parts[-1],
968             {}, [], {}, [],
969             $self->xs_dlsyms_extra . q!, 'FILE' => ! . neatvalue($ext),
970             );
971             }
972 0         0 return join "\n", @m;
973             } else {
974             return $self->xs_make_dlsyms(
975             $attribs,
976             $self->{BASEEXT} . $self->xs_dlsyms_ext,
977             'Makefile.PL',
978             $self->{NAME},
979             $self->{DLBASE},
980             $attribs->{DL_FUNCS} || $self->{DL_FUNCS} || {},
981             $attribs->{FUNCLIST} || $self->{FUNCLIST} || [],
982             $attribs->{IMPORTS} || $self->{IMPORTS} || {},
983 0   0     0 $attribs->{DL_VARS} || $self->{DL_VARS} || [],
      0        
      0        
      0        
984             $self->xs_dlsyms_extra,
985             );
986             }
987             }
988              
989             =head3 xs_make_dlsyms
990              
991             $self->xs_make_dlsyms(
992             \%attribs, # hashref from %attribs in caller
993             "$self->{BASEEXT}.def", # output file for Makefile target
994             'Makefile.PL', # dependency
995             $self->{NAME}, # shared object's "name"
996             $self->{DLBASE}, # last ::-separated part of name
997             $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {}, # various params
998             $attribs{FUNCLIST} || $self->{FUNCLIST} || [],
999             $attribs{IMPORTS} || $self->{IMPORTS} || {},
1000             $attribs{DL_VARS} || $self->{DL_VARS} || [],
1001             # optional extra param that will be added as param to Mksymlists
1002             );
1003              
1004             Utility method that returns Makefile snippet to call C<Mksymlists>.
1005              
1006             =cut
1007              
1008             sub xs_make_dlsyms {
1009 0     0 1 0 my ($self, $attribs, $target, $dep, $name, $dlbase, $funcs, $funclist, $imports, $vars, $extra) = @_;
1010 0         0 my @m = (
1011             "\n$target: $dep\n",
1012             q! $(PERLRUN) -MExtUtils::Mksymlists \\
1013             -e "Mksymlists('NAME'=>\"!, $name,
1014             q!\", 'DLBASE' => '!,$dlbase,
1015             # The above two lines quoted differently to work around
1016             # a bug in the 4DOS/4NT command line interpreter. The visible
1017             # result of the bug was files named q('extension_name',) *with the
1018             # single quotes and the comma* in the extension build directories.
1019             q!', 'DL_FUNCS' => !,neatvalue($funcs),
1020             q!, 'FUNCLIST' => !,neatvalue($funclist),
1021             q!, 'IMPORTS' => !,neatvalue($imports),
1022             q!, 'DL_VARS' => !, neatvalue($vars)
1023             );
1024 0 0       0 push @m, $extra if defined $extra;
1025 0         0 push @m, qq!);"\n!;
1026 0         0 join '', @m;
1027             }
1028              
1029             =head3 dynamic (o)
1030              
1031             Defines the dynamic target.
1032              
1033             =cut
1034              
1035             sub dynamic {
1036             # --- Dynamic Loading Sections ---
1037              
1038 153     153 1 465 my($self) = shift;
1039 153         880 '
1040             dynamic :: $(FIRST_MAKEFILE) config $(INST_BOOT) $(INST_DYNAMIC)
1041             $(NOECHO) $(NOOP)
1042             ';
1043             }
1044              
1045              
1046             =head3 makemakerdflt_target
1047              
1048             my $make_frag = $mm->makemakerdflt_target
1049              
1050             Returns a make fragment with the makemakerdeflt_target specified.
1051             This target is the first target in the Makefile, is the default target
1052             and simply points off to 'all' just in case any make variant gets
1053             confused or something gets snuck in before the real 'all' target.
1054              
1055             =cut
1056              
1057             sub makemakerdflt_target {
1058 153     153 1 816 return <<'MAKE_FRAG';
1059             makemakerdflt : all
1060             $(NOECHO) $(NOOP)
1061             MAKE_FRAG
1062              
1063             }
1064              
1065              
1066             =head3 manifypods_target
1067              
1068             my $manifypods_target = $self->manifypods_target;
1069              
1070             Generates the manifypods target. This target generates man pages from
1071             all POD files in MAN1PODS and MAN3PODS.
1072              
1073             =cut
1074              
1075             sub manifypods_target {
1076 153     153 1 484 my($self) = shift;
1077              
1078 153         403 my $man1pods = '';
1079 153         471 my $man3pods = '';
1080 153         352 my $dependencies = '';
1081              
1082             # populate manXpods & dependencies:
1083 153         397 foreach my $name (sort keys %{$self->{MAN1PODS}}, sort keys %{$self->{MAN3PODS}}) {
  153         481  
  153         908  
1084 24         97 $dependencies .= " \\\n\t$name";
1085             }
1086              
1087 153         868 my $manify = <<END;
1088             manifypods : pure_all config $dependencies
1089             END
1090              
1091 153         415 my @man_cmds;
1092 153         416 foreach my $num (qw(1 3)) {
1093 306         899 my $pods = $self->{"MAN${num}PODS"};
1094 306 50       2680 my $p2m = sprintf <<'CMD', "\$(MAN${num}SECTION)", "$]" > 5.008 ? " -u" : "";
1095             $(NOECHO) $(POD2MAN) --section=%s --perm_rw=$(PERM_RW)%s
1096             CMD
1097 306         2813 push @man_cmds, $self->split_command($p2m, map {($_,$pods->{$_})} sort keys %$pods);
  24         161  
1098             }
1099              
1100 153 100       905 $manify .= "\t\$(NOECHO) \$(NOOP)\n" unless @man_cmds;
1101 153         716 $manify .= join '', map { "$_\n" } @man_cmds;
  24         143  
1102              
1103 153         642 return $manify;
1104             }
1105              
1106             {
1107             my $has_cpan_meta;
1108             sub _has_cpan_meta {
1109 723 100   723   4216 return $has_cpan_meta if defined $has_cpan_meta;
1110 17         40 return $has_cpan_meta = !!eval {
1111 17         8412 require CPAN::Meta;
1112 17         309744 CPAN::Meta->VERSION(2.112150);
1113 16         178 1;
1114             };
1115             }
1116             }
1117              
1118             =head3 metafile_target
1119              
1120             my $target = $mm->metafile_target;
1121              
1122             Generate the metafile target.
1123              
1124             Writes the file META.yml (YAML encoded meta-data) and META.json
1125             (JSON encoded meta-data) about the module in the distdir.
1126             The format follows Module::Build's as closely as possible.
1127              
1128             =cut
1129              
1130             sub metafile_target {
1131 160     160 1 11539 my $self = shift;
1132 160 100 66     1288 return <<'MAKE_FRAG' if $self->{NO_META} or ! _has_cpan_meta();
1133             metafile :
1134             $(NOECHO) $(NOOP)
1135             MAKE_FRAG
1136              
1137             my $metadata = $self->metafile_data(
1138             $self->{META_ADD} || {},
1139             $self->{META_MERGE} || {},
1140 132   100     2951 );
      100        
1141              
1142 132         1558 my $meta = $self->_fix_metadata_before_conversion( $metadata );
1143              
1144 132         763 my @write_metayml = $self->stashmeta(
1145             $meta->as_string({version => "1.4"}), 'META_new.yml'
1146             );
1147 132         1013 my @write_metajson = $self->stashmeta(
1148             $meta->as_string({version => "2.0"}), 'META_new.json'
1149             );
1150              
1151 132         1721 my $metayml = join("\n\t", @write_metayml);
1152 132         1611 my $metajson = join("\n\t", @write_metajson);
1153 132         5041 return sprintf <<'MAKE_FRAG', $metayml, $metajson;
1154             metafile : create_distdir
1155             $(NOECHO) $(ECHO) Generating META.yml
1156             %s
1157             -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
1158             $(NOECHO) $(ECHO) Generating META.json
1159             %s
1160             -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json
1161             MAKE_FRAG
1162              
1163             }
1164              
1165             =begin private
1166              
1167             =head3 _fix_metadata_before_conversion
1168              
1169             $mm->_fix_metadata_before_conversion( \%metadata );
1170              
1171             Fixes errors in the metadata before it's handed off to L<CPAN::Meta> for
1172             conversion. This hopefully results in something that can be used further
1173             on, no guarantee is made though.
1174              
1175             =end private
1176              
1177             =cut
1178              
1179             sub _fix_metadata_before_conversion {
1180 256     256   794 my ( $self, $metadata ) = @_;
1181              
1182             # we should never be called unless this already passed but
1183             # prefer to be defensive in case somebody else calls this
1184              
1185 256 50       757 return unless _has_cpan_meta;
1186              
1187             my $bad_version = $metadata->{version} &&
1188 256   100     4369 !CPAN::Meta::Validator->new->version( 'version', $metadata->{version} );
1189             # just delete all invalid versions
1190 256 100       9705 if( $bad_version ) {
1191 8         152 warn "Can't parse version '$metadata->{version}'\n";
1192 8         166 $metadata->{version} = '';
1193             }
1194              
1195 256         1158 my $validator2 = CPAN::Meta::Validator->new( $metadata );
1196 256         2681 my @errors;
1197 256 100       1056 push @errors, $validator2->errors if !$validator2->is_valid;
1198 256         171212 my $validator14 = CPAN::Meta::Validator->new(
1199             {
1200             %$metadata,
1201             'meta-spec' => { version => 1.4 },
1202             }
1203             );
1204 256 50       3201 push @errors, $validator14->errors if !$validator14->is_valid;
1205             # fix non-camelcase custom resource keys (only other trick we know)
1206 256         97759 for my $error ( @errors ) {
1207 520         1292 my ( $key ) = ( $error =~ /Custom resource '(.*)' must be in CamelCase./ );
1208 520 100       1318 next if !$key;
1209              
1210             # first try to remove all non-alphabetic chars
1211 1         8 ( my $new_key = $key ) =~ s/[^_a-zA-Z]//g;
1212              
1213             # if that doesn't work, uppercase first one
1214 1 50       5 $new_key = ucfirst $new_key if !$validator14->custom_1( $new_key );
1215              
1216             # copy to new key if that worked
1217 1 50       12 $metadata->{resources}{$new_key} = $metadata->{resources}{$key}
1218             if $validator14->custom_1( $new_key );
1219              
1220             # and delete old one in any case
1221 1         12 delete $metadata->{resources}{$key};
1222             }
1223              
1224             # paper over validation issues, but still complain, necessary because
1225             # there's no guarantee that the above will fix ALL errors
1226 256         500 my $meta = eval { CPAN::Meta->create( $metadata, { lazy_validation => 1 } ) };
  256         3169  
1227 256 50 33     506609 warn $@ if $@ and
1228             $@ !~ /encountered CODE.*, but JSON can only represent references to arrays or hashes/;
1229              
1230             # use the original metadata straight if the conversion failed
1231             # or if it can't be stringified.
1232 256 50 33     1523 if( !$meta ||
      33        
1233 256         1736 !eval { $meta->as_string( { version => $METASPEC_V } ) } ||
1234 256         404496 !eval { $meta->as_string }
1235             ) {
1236 0         0 $meta = bless $metadata, 'CPAN::Meta';
1237             }
1238              
1239 256         362150 my $now_license = $meta->as_struct({ version => 2 })->{license};
1240 256 50 66     515102 if ($self->{LICENSE} and $self->{LICENSE} ne 'unknown' and
      66        
      33        
1241 2         22 @{$now_license} == 1 and $now_license->[0] eq 'unknown'
1242             ) {
1243 2         56 warn "Invalid LICENSE value '$self->{LICENSE}' ignored\n";
1244             }
1245              
1246 256         1739 $meta;
1247             }
1248              
1249              
1250             =begin private
1251              
1252             =head3 _sort_pairs
1253              
1254             my @pairs = _sort_pairs($sort_sub, \%hash);
1255              
1256             Sorts the pairs of a hash based on keys ordered according
1257             to C<$sort_sub>.
1258              
1259             =end private
1260              
1261             =cut
1262              
1263             sub _sort_pairs {
1264 17     17   32 my $sort = shift;
1265 17         101 my $pairs = shift;
1266 17         56 return map { $_ => $pairs->{$_} }
  34         91  
1267             sort $sort
1268             keys %$pairs;
1269             }
1270              
1271              
1272             # Taken from Module::Build::Base
1273             sub _hash_merge {
1274 15     15   29 my ($self, $h, $k, $v) = @_;
1275 15 100       40 if (ref $h->{$k} eq 'ARRAY') {
    100          
1276 1 50       2 push @{$h->{$k}}, ref $v ? @$v : $v;
  1         8  
1277             } elsif (ref $h->{$k} eq 'HASH') {
1278 7         30 $self->_hash_merge($h->{$k}, $_, $v->{$_}) foreach keys %$v;
1279             } else {
1280 7         26 $h->{$k} = $v;
1281             }
1282             }
1283              
1284              
1285             =head3 metafile_data
1286              
1287             my $metadata_hashref = $mm->metafile_data(\%meta_add, \%meta_merge);
1288              
1289             Returns the data which MakeMaker turns into the META.yml file
1290             and the META.json file. It is always in version 2.0 of the format.
1291              
1292             Values of %meta_add will overwrite any existing metadata in those
1293             keys. %meta_merge will be merged with them.
1294              
1295             =cut
1296              
1297             sub metafile_data {
1298 300     300 1 38226 my $self = shift;
1299 300         782 my($meta_add, $meta_merge) = @_;
1300              
1301 300   100     812 $meta_add ||= {};
1302 300   100     902 $meta_merge ||= {};
1303              
1304 300         1730 my $version = _normalize_version($self->{VERSION});
1305 300 100       1942 my $release_status = ($version =~ /_/) ? 'unstable' : 'stable';
1306             my %meta = (
1307             # required
1308             abstract => $self->{ABSTRACT} || 'unknown',
1309             author => defined($self->{AUTHOR}) ? $self->{AUTHOR} : ['unknown'],
1310             dynamic_config => 1,
1311             generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION",
1312             license => [ $self->{LICENSE} || 'unknown' ],
1313             'meta-spec' => {
1314             url => $METASPEC_URL,
1315             version => $METASPEC_V,
1316             },
1317             name => $self->{DISTNAME},
1318 300 100 100     11840 release_status => $release_status,
      100        
1319             version => $version,
1320              
1321             # optional
1322             no_index => { directory => [qw(t inc)] },
1323             );
1324 300         2831 $self->_add_requirements_to_meta(\%meta);
1325              
1326 300 50       729 if (!eval { require JSON::PP; require CPAN::Meta::Converter; CPAN::Meta::Converter->VERSION(2.141170) }) {
  300         17380  
  300         295919  
  300         28246  
1327 0         0 return \%meta;
1328             }
1329              
1330             # needs to be based on the original version
1331 300         1844 my $v1_add = _metaspec_version($meta_add) !~ /^2/;
1332              
1333 300         1173 my ($add_v, $merge_v) = map _metaspec_version($_), $meta_add, $meta_merge;
1334 300         1321 for my $frag ($meta_add, $meta_merge) {
1335 600 100       150505 my $def_v = $frag == $meta_add ? $merge_v : $add_v;
1336 600         3717 $frag = CPAN::Meta::Converter->new($frag, default_version => $def_v)->upgrade_fragment;
1337             }
1338              
1339             # if we upgraded a 1.x _ADD fragment, we gave it a prereqs key that
1340             # will override all prereqs, which is more than the user asked for;
1341             # instead, we'll go inside the prereqs and override all those
1342 300         101348 while( my($key, $val) = each %$meta_add ) {
1343 306 100 100     4823 if ($v1_add and $key eq 'prereqs') {
    100          
1344 3         36 $meta{$key}{$_} = $val->{$_} for keys %$val;
1345             } elsif ($key ne 'meta-spec') {
1346 3         14 $meta{$key} = $val;
1347             }
1348             }
1349              
1350 300         1340 while( my($key, $val) = each %$meta_merge ) {
1351 306 100       1904 next if $key eq 'meta-spec';
1352 6         20 $self->_hash_merge(\%meta, $key, $val);
1353             }
1354              
1355 300         1894 return \%meta;
1356             }
1357              
1358              
1359             =begin private
1360              
1361             =cut
1362              
1363             sub _add_requirements_to_meta {
1364 455     455   1156 my ( $self, $meta ) = @_;
1365             # Check the original args so we can tell between the user setting it
1366             # to an empty hash and it just being initialized.
1367             $meta->{prereqs}{configure}{requires} = $self->{ARGS}{CONFIGURE_REQUIRES}
1368             ? $self->{CONFIGURE_REQUIRES}
1369 455 100       3032 : { 'ExtUtils::MakeMaker' => 0, };
1370             $meta->{prereqs}{build}{requires} = $self->{ARGS}{BUILD_REQUIRES}
1371             ? $self->{BUILD_REQUIRES}
1372 455 100       1902 : { 'ExtUtils::MakeMaker' => 0, };
1373             $meta->{prereqs}{test}{requires} = $self->{TEST_REQUIRES}
1374 455 100       1464 if $self->{ARGS}{TEST_REQUIRES};
1375             $meta->{prereqs}{runtime}{requires} = $self->{PREREQ_PM}
1376 455 100       1347 if $self->{ARGS}{PREREQ_PM};
1377             $meta->{prereqs}{runtime}{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION})
1378 455 100       1448 if $self->{MIN_PERL_VERSION};
1379             }
1380              
1381             # spec version of given fragment - if not given, assume 1.4
1382             sub _metaspec_version {
1383 900     900   2090 my ( $meta ) = @_;
1384             return $meta->{'meta-spec'}->{version}
1385             if defined $meta->{'meta-spec'}
1386 900 100 66     3065 and defined $meta->{'meta-spec'}->{version};
1387 890         3261 return '1.4';
1388             }
1389              
1390             sub _add_requirements_to_meta_v1_4 {
1391 0     0   0 my ( $self, $meta ) = @_;
1392             # Check the original args so we can tell between the user setting it
1393             # to an empty hash and it just being initialized.
1394 0 0       0 if( $self->{ARGS}{CONFIGURE_REQUIRES} ) {
1395 0         0 $meta->{configure_requires} = $self->{CONFIGURE_REQUIRES};
1396             } else {
1397             $meta->{configure_requires} = {
1398 0         0 'ExtUtils::MakeMaker' => 0,
1399             };
1400             }
1401 0 0       0 if( $self->{ARGS}{BUILD_REQUIRES} ) {
1402 0         0 $meta->{build_requires} = $self->{BUILD_REQUIRES};
1403             } else {
1404             $meta->{build_requires} = {
1405 0         0 'ExtUtils::MakeMaker' => 0,
1406             };
1407             }
1408 0 0       0 if( $self->{ARGS}{TEST_REQUIRES} ) {
1409             $meta->{build_requires} = {
1410 0         0 %{ $meta->{build_requires} },
1411 0         0 %{ $self->{TEST_REQUIRES} },
  0         0  
1412             };
1413             }
1414             $meta->{requires} = $self->{PREREQ_PM}
1415 0 0       0 if defined $self->{PREREQ_PM};
1416             $meta->{requires}{perl} = _normalize_version($self->{MIN_PERL_VERSION})
1417 0 0       0 if $self->{MIN_PERL_VERSION};
1418             }
1419              
1420             # Adapted from Module::Build::Base
1421             sub _normalize_version {
1422 318     318   1030 my ($version) = @_;
1423 318 100       912 $version = 0 unless defined $version;
1424              
1425 318 100       4514 if ( ref $version eq 'version' ) { # version objects
    50          
1426 4         41 $version = $version->stringify;
1427             }
1428             elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
1429             # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
1430 0         0 $version = "v$version";
1431             }
1432             else {
1433             # leave alone
1434             }
1435 318         1012 return $version;
1436             }
1437              
1438             =head3 _dump_hash
1439              
1440             $yaml = _dump_hash(\%options, %hash);
1441              
1442             Implements a fake YAML dumper for a hash given
1443             as a list of pairs. No quoting/escaping is done. Keys
1444             are supposed to be strings. Values are undef, strings,
1445             hash refs or array refs of strings.
1446              
1447             Supported options are:
1448              
1449             delta => STR - indentation delta
1450             use_header => BOOL - whether to include a YAML header
1451             indent => STR - a string of spaces
1452             default: ''
1453              
1454             max_key_length => INT - maximum key length used to align
1455             keys and values of the same hash
1456             default: 20
1457             key_sort => CODE - a sort sub
1458             It may be undef, which means no sorting by keys
1459             default: sub { lc $a cmp lc $b }
1460              
1461             customs => HASH - special options for certain keys
1462             (whose values are hashes themselves)
1463             may contain: max_key_length, key_sort, customs
1464              
1465             =end private
1466              
1467             =cut
1468              
1469             sub _dump_hash {
1470 31 50   31   85 croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH';
1471 31         41 my $options = shift;
1472 31         99 my %hash = @_;
1473              
1474             # Use a list to preserve order.
1475 31         52 my @pairs;
1476              
1477             my $k_sort
1478             = exists $options->{key_sort} ? $options->{key_sort}
1479 31 100   19   105 : sub { lc $a cmp lc $b };
  19         68  
1480 31 100       59 if ($k_sort) {
1481 17 50       38 croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE';
1482 17         32 @pairs = _sort_pairs($k_sort, \%hash);
1483             } else { # list of pairs, no sorting
1484 14         38 @pairs = @_;
1485             }
1486              
1487 31 100       98 my $yaml = $options->{use_header} ? "--- #YAML:1.0\n" : '';
1488 31   100     84 my $indent = $options->{indent} || '';
1489             my $k_length = min(
1490             ($options->{max_key_length} || 20),
1491 31   50     114 max(map { length($_) + 1 } grep { !ref $hash{$_} } keys %hash)
  80         182  
  106         235  
1492             );
1493 31   50     133 my $customs = $options->{customs} || {};
1494              
1495             # printf format for key
1496 31         84 my $k_format = "%-${k_length}s";
1497              
1498 31         69 while( @pairs ) {
1499 106         249 my($key, $val) = splice @pairs, 0, 2;
1500 106 100       230 $val = '~' unless defined $val;
1501 106 100 66     307 if(ref $val eq 'HASH') {
    100          
    100          
1502 18 100       46 if ( keys %$val ) {
1503             my %k_options = ( # options for recursive call
1504             delta => $options->{delta},
1505             use_header => 0,
1506             indent => $indent . $options->{delta},
1507 17         64 );
1508 17 50       41 if (exists $customs->{$key}) {
1509 0         0 my %k_custom = %{$customs->{$key}};
  0         0  
1510 0         0 foreach my $k (qw(key_sort max_key_length customs)) {
1511 0 0       0 $k_options{$k} = $k_custom{$k} if exists $k_custom{$k};
1512             }
1513             }
1514 17         91 $yaml .= $indent . "$key:\n"
1515             . _dump_hash(\%k_options, %$val);
1516             }
1517             else {
1518 1         4 $yaml .= $indent . "$key: {}\n";
1519             }
1520             }
1521             elsif (ref $val eq 'ARRAY') {
1522 7 100       15 if( @$val ) {
1523 6         16 $yaml .= $indent . "$key:\n";
1524              
1525 6         12 for (@$val) {
1526 10 100       121 croak "only nested arrays of non-refs are supported" if ref $_;
1527 9         28 $yaml .= $indent . $options->{delta} . "- $_\n";
1528             }
1529             }
1530             else {
1531 1         4 $yaml .= $indent . "$key: []\n";
1532             }
1533             }
1534             elsif( ref $val and !blessed($val) ) {
1535 1         236 croak "only nested hashes, arrays and objects are supported";
1536             }
1537             else { # if it's an object, just stringify it
1538 80         389 $yaml .= $indent . sprintf "$k_format %s\n", "$key:", $val;
1539             }
1540             };
1541              
1542 29         197 return $yaml;
1543              
1544             }
1545              
1546             sub blessed {
1547 1     1 0 5 return eval { $_[0]->isa("UNIVERSAL"); };
  1         15  
1548             }
1549              
1550             sub max {
1551 31     31 0 95 return (sort { $b <=> $a } @_)[0];
  110         216  
1552             }
1553              
1554             sub min {
1555 31     31 0 67 return (sort { $a <=> $b } @_)[0];
  26         57  
1556             }
1557              
1558             =head3 metafile_file
1559              
1560             my $meta_yml = $mm->metafile_file(@metadata_pairs);
1561              
1562             Turns the @metadata_pairs into YAML.
1563              
1564             This method does not implement a complete YAML dumper, being limited
1565             to dump a hash with values which are strings, undef's or nested hashes
1566             and arrays of strings. No quoting/escaping is done.
1567              
1568             =cut
1569              
1570             sub metafile_file {
1571 14     14 1 16995 my $self = shift;
1572              
1573 14         54 my %dump_options = (
1574             use_header => 1,
1575             delta => ' ' x 4,
1576             key_sort => undef,
1577             );
1578 14         44 return _dump_hash(\%dump_options, @_);
1579              
1580             }
1581              
1582              
1583             =head3 distmeta_target
1584              
1585             my $make_frag = $mm->distmeta_target;
1586              
1587             Generates the distmeta target to add META.yml and META.json to the MANIFEST
1588             in the distdir.
1589              
1590             =cut
1591              
1592             sub distmeta_target {
1593 153     153 1 527 my $self = shift;
1594              
1595 153         1350 my @add_meta = (
1596             $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']),
1597             exit unless -e q{META.yml};
1598             eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }
1599             or die "Could not add META.yml to MANIFEST: ${'@'}"
1600             CODE
1601             $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd'])
1602             exit unless -f q{META.json};
1603             eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }
1604             or die "Could not add META.json to MANIFEST: ${'@'}"
1605             CODE
1606             );
1607              
1608 153         645 my @add_meta_to_distdir = map { $self->cd('$(DISTVNAME)', $_) } @add_meta;
  306         1883  
1609              
1610 153         1456 return sprintf <<'MAKE', @add_meta_to_distdir;
1611             distmeta : create_distdir metafile
1612             $(NOECHO) %s
1613             $(NOECHO) %s
1614              
1615             MAKE
1616              
1617             }
1618              
1619              
1620             =head3 mymeta
1621              
1622             my $mymeta = $mm->mymeta;
1623              
1624             Generate MYMETA information as a hash either from an existing CPAN Meta file
1625             (META.json or META.yml) or from internal data.
1626              
1627             =cut
1628              
1629             sub mymeta {
1630 155     155 1 19944 my $self = shift;
1631 155   100     1113 my $file = shift || ''; # for testing
1632              
1633 155         1952 my $mymeta = $self->_mymeta_from_meta($file);
1634 155         385 my $v2 = 1;
1635              
1636 155 100       486 unless ( $mymeta ) {
1637             $mymeta = $self->metafile_data(
1638             $self->{META_ADD} || {},
1639             $self->{META_MERGE} || {},
1640 151   50     2352 );
      50        
1641 151         659 $v2 = 0;
1642             }
1643              
1644             # Overwrite the non-configure dependency hashes
1645 155         659 $self->_add_requirements_to_meta($mymeta);
1646              
1647 155         424 $mymeta->{dynamic_config} = 0;
1648              
1649 155         1433 return $mymeta;
1650             }
1651              
1652              
1653             sub _mymeta_from_meta {
1654 155     155   422 my $self = shift;
1655 155   100     993 my $metafile = shift || ''; # for testing
1656              
1657 155 100       601 return unless _has_cpan_meta();
1658              
1659 127         362 my $meta;
1660 127         663 for my $file ( $metafile, "META.json", "META.yml" ) {
1661 373 100       3950 next unless -e $file;
1662 4         34 eval {
1663 4         22 $meta = CPAN::Meta->load_file($file)->as_struct( { version => 2 } );
1664             };
1665 4 50       60956 last if $meta;
1666             }
1667 127 100       681 return unless $meta;
1668              
1669             # META.yml before 6.25_01 cannot be trusted. META.yml lived in the source directory.
1670             # There was a good chance the author accidentally uploaded a stale META.yml if they
1671             # rolled their own tarball rather than using "make dist".
1672 4 50 33     40 if ($meta->{generated_by} &&
1673             $meta->{generated_by} =~ /ExtUtils::MakeMaker version ([\d\._]+)/) {
1674 52     52   544 my $eummv = do { no warnings; $1+0; };
  52         134  
  52         300980  
  4         9  
  4         25  
1675 4 50       12 if ($eummv < 6.2501) {
1676 0         0 return;
1677             }
1678             }
1679              
1680 4         24 return $meta;
1681             }
1682              
1683             =head3 write_mymeta
1684              
1685             $self->write_mymeta( $mymeta );
1686              
1687             Write MYMETA information to MYMETA.json and MYMETA.yml.
1688              
1689             =cut
1690              
1691             sub write_mymeta {
1692 152     152 1 1689 my $self = shift;
1693 152         325 my $mymeta = shift;
1694              
1695 152 100       401 return unless _has_cpan_meta();
1696              
1697 124         730 my $meta_obj = $self->_fix_metadata_before_conversion( $mymeta );
1698              
1699 124         1275 $meta_obj->save( 'MYMETA.json', { version => "2.0" } );
1700 124         430962 $meta_obj->save( 'MYMETA.yml', { version => "1.4" } );
1701 124         397505 return 1;
1702             }
1703              
1704             =head3 realclean (o)
1705              
1706             Defines the realclean target.
1707              
1708             =cut
1709              
1710             sub realclean {
1711 153     153 1 664 my($self, %attribs) = @_;
1712              
1713 153         936 my @dirs = qw($(DISTVNAME));
1714 153         965 my @files = qw($(FIRST_MAKEFILE) $(MAKEFILE_OLD));
1715              
1716             # Special exception for the perl core where INST_* is not in blib.
1717             # This cleans up the files built from the ext/ directory (all XS).
1718 153 50       627 if( $self->{PERL_CORE} ) {
1719 0         0 push @dirs, qw($(INST_AUTODIR) $(INST_ARCHAUTODIR));
1720 0         0 push @files, values %{$self->{PM}};
  0         0  
1721             }
1722              
1723 153 50       586 if( $self->has_link_code ){
1724 0         0 push @files, qw($(OBJECT));
1725             }
1726              
1727 153 50       655 if( $attribs{FILES} ) {
1728 0 0       0 if( ref $attribs{FILES} ) {
1729 0         0 push @dirs, @{ $attribs{FILES} };
  0         0  
1730             }
1731             else {
1732 0         0 push @dirs, split /\s+/, $attribs{FILES};
1733             }
1734             }
1735              
1736             # Occasionally files are repeated several times from different sources
1737 153         473 { my(%f) = map { ($_ => 1) } @files; @files = sort keys %f; }
  306         1276  
  153         977  
1738 153         296 { my(%d) = map { ($_ => 1) } @dirs; @dirs = sort keys %d; }
  153         350  
  153         364  
  153         795  
  153         694  
1739              
1740 153         649 my $rm_cmd = join "\n\t", map { "$_" }
  153         851  
1741             $self->split_command('- $(RM_F)', @files);
1742 153         651 my $rmf_cmd = join "\n\t", map { "$_" }
  153         1243  
1743             $self->split_command('- $(RM_RF)', @dirs);
1744              
1745 153         1198 my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd;
1746             # Delete temporary files (via clean) and also delete dist files
1747             realclean purge :: realclean_subdirs
1748             %s
1749             %s
1750             MAKE
1751              
1752 153 50       733 $m .= "\t$attribs{POSTOP}\n" if $attribs{POSTOP};
1753              
1754 153         762 return $m;
1755             }
1756              
1757              
1758             =head3 realclean_subdirs_target
1759              
1760             my $make_frag = $MM->realclean_subdirs_target;
1761              
1762             Returns the realclean_subdirs target. This is used by the realclean
1763             target to call realclean on any subdirectories which contain Makefiles.
1764              
1765             =cut
1766              
1767             sub realclean_subdirs_target {
1768 153     153 1 574 my $self = shift;
1769 153         926 my @m = <<'EOF';
1770             # so clean is forced to complete before realclean_subdirs runs
1771             realclean_subdirs : clean
1772             EOF
1773 153 100       410 return join '', @m, "\t\$(NOECHO) \$(NOOP)\n" unless @{$self->{DIR}};
  153         1214  
1774 56         145 foreach my $dir (@{$self->{DIR}}) {
  56         348  
1775 56         195 foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) {
1776 112         527 my $subrclean .= $self->oneliner(_sprintf562 <<'CODE', $dir, $makefile);
1777             chdir '%1$s'; system '$(MAKE) $(USEMAKEFILE) %2$s realclean' if -f '%2$s';
1778             CODE
1779 112         720 push @m, "\t- $subrclean\n";
1780             }
1781             }
1782 56         407 return join '', @m;
1783             }
1784              
1785              
1786             =head3 signature_target
1787              
1788             my $target = $mm->signature_target;
1789              
1790             Generate the signature target.
1791              
1792             Writes the file SIGNATURE with "cpansign -s".
1793              
1794             =cut
1795              
1796             sub signature_target {
1797 153     153 1 483 my $self = shift;
1798              
1799 153         624 return <<'MAKE_FRAG';
1800             signature :
1801             cpansign -s
1802             MAKE_FRAG
1803              
1804             }
1805              
1806              
1807             =head3 distsignature_target
1808              
1809             my $make_frag = $mm->distsignature_target;
1810              
1811             Generates the distsignature target to add SIGNATURE to the MANIFEST in the
1812             distdir.
1813              
1814             =cut
1815              
1816             sub distsignature_target {
1817 153     153 1 515 my $self = shift;
1818              
1819 153         767 my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']);
1820             eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) }
1821             or die "Could not add SIGNATURE to MANIFEST: ${'@'}"
1822             CODE
1823              
1824 153         700 my $sign_dist = $self->cd('$(DISTVNAME)' => 'cpansign -s');
1825              
1826             # cpansign -s complains if SIGNATURE is in the MANIFEST yet does not
1827             # exist
1828 153         590 my $touch_sig = $self->cd('$(DISTVNAME)' => '$(TOUCH) SIGNATURE');
1829 153         496 my $add_sign_to_dist = $self->cd('$(DISTVNAME)' => $add_sign );
1830              
1831 153         1126 return sprintf <<'MAKE', $add_sign_to_dist, $touch_sig, $sign_dist
1832             distsignature : distmeta
1833             $(NOECHO) %s
1834             $(NOECHO) %s
1835             %s
1836              
1837             MAKE
1838              
1839             }
1840              
1841              
1842             =head3 special_targets
1843              
1844             my $make_frag = $mm->special_targets
1845              
1846             Returns a make fragment containing any targets which have special
1847             meaning to make. For example, .SUFFIXES and .PHONY.
1848              
1849             =cut
1850              
1851             sub special_targets {
1852 153     153 1 761 my $make_frag = <<'MAKE_FRAG';
1853             .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
1854              
1855             .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir pure_all subdirs clean_subdirs makemakerdflt manifypods realclean_subdirs subdirs_dynamic subdirs_pure_nolink subdirs_static subdirs-test_dynamic subdirs-test_static test_dynamic test_static
1856              
1857             MAKE_FRAG
1858              
1859 153 50       657 $make_frag .= <<'MAKE_FRAG' if $ENV{CLEARCASE_ROOT};
1860             .NO_CONFIG_REC: Makefile
1861              
1862             MAKE_FRAG
1863              
1864 153         589 return $make_frag;
1865             }
1866              
1867              
1868              
1869              
1870             =head2 Init methods
1871              
1872             Methods which help initialize the MakeMaker object and macros.
1873              
1874              
1875             =head3 init_ABSTRACT
1876              
1877             $mm->init_ABSTRACT
1878              
1879             =cut
1880              
1881             sub init_ABSTRACT {
1882 155     155 1 560 my $self = shift;
1883              
1884 155 50 66     703 if( $self->{ABSTRACT_FROM} and $self->{ABSTRACT} ) {
1885 0         0 warn "Both ABSTRACT_FROM and ABSTRACT are set. ".
1886             "Ignoring ABSTRACT_FROM.\n";
1887 0         0 return;
1888             }
1889              
1890 155 100       788 if ($self->{ABSTRACT_FROM}){
1891 1 50       40 $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or
1892             carp "WARNING: Setting ABSTRACT via file ".
1893             "'$self->{ABSTRACT_FROM}' failed\n";
1894             }
1895              
1896 155 50 66     817 if ($self->{ABSTRACT} && $self->{ABSTRACT} =~ m![[:cntrl:]]+!) {
1897 0         0 warn "WARNING: ABSTRACT contains control character(s),".
1898             " they will be removed\n";
1899 0         0 $self->{ABSTRACT} =~ s![[:cntrl:]]+!!g;
1900 0         0 return;
1901             }
1902             }
1903              
1904             =head3 init_INST
1905              
1906             $mm->init_INST;
1907              
1908             Called by init_main. Sets up all INST_* variables except those related
1909             to XS code. Those are handled in init_xs.
1910              
1911             =cut
1912              
1913             sub init_INST {
1914 156     156 1 700 my($self) = shift;
1915              
1916 156   66     2165 $self->{INST_ARCHLIB} ||= $self->catdir($Curdir,"blib","arch");
1917 156   66     1770 $self->{INST_BIN} ||= $self->catdir($Curdir,'blib','bin');
1918              
1919             # INST_LIB typically pre-set if building an extension after
1920             # perl has been built and installed. Setting INST_LIB allows
1921             # you to build directly into, say $Config{privlibexp}.
1922 156 100       622 unless ($self->{INST_LIB}){
1923 99 50       387 if ($self->{PERL_CORE}) {
1924 0         0 $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
1925             } else {
1926 99         664 $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib");
1927             }
1928             }
1929              
1930 156         916 my @parentdir = split(/::/, $self->{PARENT_NAME});
1931 156         1510 $self->{INST_LIBDIR} = $self->catdir('$(INST_LIB)', @parentdir);
1932 156         1156 $self->{INST_ARCHLIBDIR} = $self->catdir('$(INST_ARCHLIB)', @parentdir);
1933 156         1086 $self->{INST_AUTODIR} = $self->catdir('$(INST_LIB)', 'auto',
1934             '$(FULLEXT)');
1935 156         955 $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto',
1936             '$(FULLEXT)');
1937              
1938 156   66     1749 $self->{INST_SCRIPT} ||= $self->catdir($Curdir,'blib','script');
1939              
1940 156   66     1106 $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1');
1941 156   66     1187 $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3');
1942              
1943 156         478 return 1;
1944             }
1945              
1946              
1947             =head3 init_INSTALL
1948              
1949             $mm->init_INSTALL;
1950              
1951             Called by init_main. Sets up all INSTALL_* variables (except
1952             INSTALLDIRS) and *PREFIX.
1953              
1954             =cut
1955              
1956             sub init_INSTALL {
1957 155     155 1 556 my($self) = shift;
1958              
1959 155 50 66     666 if( $self->{ARGS}{INSTALL_BASE} and $self->{ARGS}{PREFIX} ) {
1960 0         0 die "Only one of PREFIX or INSTALL_BASE can be given. Not both.\n";
1961             }
1962              
1963 155 100       522 if( $self->{ARGS}{INSTALL_BASE} ) {
1964 2         38 $self->init_INSTALL_from_INSTALL_BASE;
1965             }
1966             else {
1967 153         2002 $self->init_INSTALL_from_PREFIX;
1968             }
1969             }
1970              
1971              
1972             =head3 init_INSTALL_from_PREFIX
1973              
1974             $mm->init_INSTALL_from_PREFIX;
1975              
1976             =cut
1977              
1978             sub init_INSTALL_from_PREFIX {
1979 153     153 1 474 my $self = shift;
1980              
1981 153         2220 $self->init_lib2arch;
1982              
1983             # There are often no Config.pm defaults for these new man variables so
1984             # we fall back to the old behavior which is to use installman*dir
1985 153         1280 foreach my $num (1, 3) {
1986 306         1017 my $k = 'installsiteman'.$num.'dir';
1987              
1988             $self->{uc $k} ||= uc "\$(installman${num}dir)"
1989 306 100 66     2819 unless $Config{$k};
1990             }
1991              
1992 153         497 foreach my $num (1, 3) {
1993 306         1064 my $k = 'installvendorman'.$num.'dir';
1994              
1995 306 100       989 unless( $Config{$k} ) {
1996             $self->{uc $k} ||= $Config{usevendorprefix}
1997 304 100 100     2612 ? uc "\$(installman${num}dir)"
1998             : '';
1999             }
2000             }
2001              
2002             $self->{INSTALLSITEBIN} ||= '$(INSTALLBIN)'
2003 153 50 0     739 unless $Config{installsitebin};
2004             $self->{INSTALLSITESCRIPT} ||= '$(INSTALLSCRIPT)'
2005 153 50 0     516 unless $Config{installsitescript};
2006              
2007 153 50       517 unless( $Config{installvendorbin} ) {
2008             $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix}
2009             ? $Config{installbin}
2010 153 100 66     1643 : '';
2011             }
2012 153 50       693 unless( $Config{installvendorscript} ) {
2013             $self->{INSTALLVENDORSCRIPT} ||= $Config{usevendorprefix}
2014             ? $Config{installscript}
2015 153 100 66     1682 : '';
2016             }
2017              
2018              
2019             my $iprefix = $Config{installprefixexp} || $Config{installprefix} ||
2020 153   0     1336 $Config{prefixexp} || $Config{prefix} || '';
2021 153 100       668 my $vprefix = $Config{usevendorprefix} ? $Config{vendorprefixexp} : '';
2022 153   50     869 my $sprefix = $Config{siteprefixexp} || '';
2023              
2024             # 5.005_03 doesn't have a siteprefix.
2025 153 50       563 $sprefix = $iprefix unless $sprefix;
2026              
2027              
2028 153   100     1493 $self->{PREFIX} ||= '';
2029              
2030 153 100       571 if( $self->{PREFIX} ) {
2031 2         5 @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} =
  2         13  
2032             ('$(PREFIX)') x 3;
2033             }
2034             else {
2035 151   33     1352 $self->{PERLPREFIX} ||= $iprefix;
2036 151   33     978 $self->{SITEPREFIX} ||= $sprefix;
2037 151   66     838 $self->{VENDORPREFIX} ||= $vprefix;
2038              
2039             # Lots of MM extension authors like to use $(PREFIX) so we
2040             # put something sensible in there no matter what.
2041 151         762 $self->{PREFIX} = '$('.uc $self->{INSTALLDIRS}.'PREFIX)';
2042             }
2043              
2044 153         810 my $arch = $Config{archname};
2045 153         505 my $version = $Config{version};
2046              
2047             # default style
2048 153   50     638 my $libstyle = $Config{installstyle} || 'lib/perl5';
2049 153         697 my $manstyle = '';
2050              
2051 153 50       627 if( $self->{LIBSTYLE} ) {
2052 0         0 $libstyle = $self->{LIBSTYLE};
2053 0 0       0 $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : '';
2054             }
2055              
2056             # Some systems, like VOS, set installman*dir to '' if they can't
2057             # read man pages.
2058 153         411 for my $num (1, 3) {
2059             $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none'
2060 306 100 100     2556 unless $Config{'installman'.$num.'dir'};
2061             }
2062              
2063 153         5326 my %bin_layouts =
2064             (
2065             bin => { s => $iprefix,
2066             t => 'perl',
2067             d => 'bin' },
2068             vendorbin => { s => $vprefix,
2069             t => 'vendor',
2070             d => 'bin' },
2071             sitebin => { s => $sprefix,
2072             t => 'site',
2073             d => 'bin' },
2074             script => { s => $iprefix,
2075             t => 'perl',
2076             d => 'bin' },
2077             vendorscript=> { s => $vprefix,
2078             t => 'vendor',
2079             d => 'bin' },
2080             sitescript => { s => $sprefix,
2081             t => 'site',
2082             d => 'bin' },
2083             );
2084              
2085 153         4143 my %man_layouts =
2086             (
2087             man1dir => { s => $iprefix,
2088             t => 'perl',
2089             d => 'man/man1',
2090             style => $manstyle, },
2091             siteman1dir => { s => $sprefix,
2092             t => 'site',
2093             d => 'man/man1',
2094             style => $manstyle, },
2095             vendorman1dir => { s => $vprefix,
2096             t => 'vendor',
2097             d => 'man/man1',
2098             style => $manstyle, },
2099              
2100             man3dir => { s => $iprefix,
2101             t => 'perl',
2102             d => 'man/man3',
2103             style => $manstyle, },
2104             siteman3dir => { s => $sprefix,
2105             t => 'site',
2106             d => 'man/man3',
2107             style => $manstyle, },
2108             vendorman3dir => { s => $vprefix,
2109             t => 'vendor',
2110             d => 'man/man3',
2111             style => $manstyle, },
2112             );
2113              
2114 153         4028 my %lib_layouts =
2115             (
2116             privlib => { s => $iprefix,
2117             t => 'perl',
2118             d => '',
2119             style => $libstyle, },
2120             vendorlib => { s => $vprefix,
2121             t => 'vendor',
2122             d => '',
2123             style => $libstyle, },
2124             sitelib => { s => $sprefix,
2125             t => 'site',
2126             d => 'site_perl',
2127             style => $libstyle, },
2128              
2129             archlib => { s => $iprefix,
2130             t => 'perl',
2131             d => "$version/$arch",
2132             style => $libstyle },
2133             vendorarch => { s => $vprefix,
2134             t => 'vendor',
2135             d => "$version/$arch",
2136             style => $libstyle },
2137             sitearch => { s => $sprefix,
2138             t => 'site',
2139             d => "site_perl/$version/$arch",
2140             style => $libstyle },
2141             );
2142              
2143              
2144             # Special case for LIB.
2145 153 50       747 if( $self->{LIB} ) {
2146 0         0 foreach my $var (keys %lib_layouts) {
2147 0         0 my $Installvar = uc "install$var";
2148              
2149 0 0       0 if( $var =~ /arch/ ) {
2150             $self->{$Installvar} ||=
2151 0   0     0 $self->catdir($self->{LIB}, $Config{archname});
2152             }
2153             else {
2154 0   0     0 $self->{$Installvar} ||= $self->{LIB};
2155             }
2156             }
2157             }
2158              
2159 153         1398 my %type2prefix = ( perl => 'PERLPREFIX',
2160             site => 'SITEPREFIX',
2161             vendor => 'VENDORPREFIX'
2162             );
2163              
2164 153         1733 my %layouts = (%bin_layouts, %man_layouts, %lib_layouts);
2165 153         1213 while( my($var, $layout) = each(%layouts) ) {
2166 2754         4084 my($s, $t, $d, $style) = @{$layout}{qw(s t d style)};
  2754         6489  
2167 2754         5776 my $r = '$('.$type2prefix{$t}.')';
2168              
2169 2754 50       5154 warn "Prefixing $var\n" if $Verbose >= 2;
2170              
2171 2754         4394 my $installvar = "install$var";
2172 2754         4502 my $Installvar = uc $installvar;
2173 2754 100       6453 next if $self->{$Installvar};
2174              
2175 2218 100       4566 $d = "$style/$d" if $style;
2176 2218         7620 $self->prefixify($installvar, $s, $r, $d);
2177              
2178 2218 50       8284 warn " $Installvar == $self->{$Installvar}\n"
2179             if $Verbose >= 2;
2180             }
2181              
2182             # Generate these if they weren't figured out.
2183 153   66     1603 $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH};
2184 153   66     979 $self->{VENDORLIBEXP} ||= $self->{INSTALLVENDORLIB};
2185              
2186 153         2115 return 1;
2187             }
2188              
2189              
2190             =head3 init_from_INSTALL_BASE
2191              
2192             $mm->init_from_INSTALL_BASE
2193              
2194             =cut
2195              
2196             my %map = (
2197             lib => [qw(lib perl5)],
2198             arch => [('lib', 'perl5', $Config{archname})],
2199             bin => [qw(bin)],
2200             man1dir => [qw(man man1)],
2201             man3dir => [qw(man man3)]
2202             );
2203             $map{script} = $map{bin};
2204              
2205             sub init_INSTALL_from_INSTALL_BASE {
2206 2     2 0 12 my $self = shift;
2207              
2208 2         12 @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} =
  2         14  
2209             '$(INSTALL_BASE)';
2210              
2211 2         13 my %install;
2212 2         40 foreach my $thing (keys %map) {
2213 12         33 foreach my $dir (('', 'SITE', 'VENDOR')) {
2214 36         62 my $uc_thing = uc $thing;
2215 36         73 my $key = "INSTALL".$dir.$uc_thing;
2216              
2217             $install{$key} ||=
2218             ($thing =~ /^man.dir$/ and not $Config{lc $key})
2219             ? 'none'
2220 36 100 66     207 : $self->catdir('$(INSTALL_BASE)', @{$map{$thing}});
  24   33     131  
2221             }
2222             }
2223              
2224             # Adjust for variable quirks.
2225 2   33     22 $install{INSTALLARCHLIB} ||= delete $install{INSTALLARCH};
2226 2   33     25 $install{INSTALLPRIVLIB} ||= delete $install{INSTALLLIB};
2227              
2228 2         12 foreach my $key (keys %install) {
2229 36   33     98 $self->{$key} ||= $install{$key};
2230             }
2231              
2232 2         14 return 1;
2233             }
2234              
2235              
2236             =head3 init_VERSION I<Abstract>
2237              
2238             $mm->init_VERSION
2239              
2240             Initialize macros representing versions of MakeMaker and other tools
2241              
2242             MAKEMAKER: path to the MakeMaker module.
2243              
2244             MM_VERSION: ExtUtils::MakeMaker Version
2245              
2246             MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards
2247             compat)
2248              
2249             VERSION: version of your module
2250              
2251             VERSION_MACRO: which macro represents the version (usually 'VERSION')
2252              
2253             VERSION_SYM: like version but safe for use as an RCS revision number
2254              
2255             DEFINE_VERSION: -D line to set the module version when compiling
2256              
2257             XS_VERSION: version in your .xs file. Defaults to $(VERSION)
2258              
2259             XS_VERSION_MACRO: which macro represents the XS version.
2260              
2261             XS_DEFINE_VERSION: -D line to set the xs version when compiling.
2262              
2263             Called by init_main.
2264              
2265             =cut
2266              
2267             sub init_VERSION {
2268 155     155 1 592 my($self) = shift;
2269              
2270 155         987 $self->{MAKEMAKER} = $ExtUtils::MakeMaker::Filename;
2271 155         717 $self->{MM_VERSION} = $ExtUtils::MakeMaker::VERSION;
2272 155         1111 $self->{MM_REVISION}= $ExtUtils::MakeMaker::Revision;
2273 155   100     1194 $self->{VERSION_FROM} ||= '';
2274              
2275 155 100       653 if ($self->{VERSION_FROM}){
2276 94         2070 $self->{VERSION} = $self->parse_version($self->{VERSION_FROM});
2277 94 50       698 if( $self->{VERSION} eq 'undef' ) {
2278 0         0 carp("WARNING: Setting VERSION via file ".
2279             "'$self->{VERSION_FROM}' failed\n");
2280             }
2281             }
2282              
2283 155 100       616 if (defined $self->{VERSION}) {
2284 107 100       1344 if ( $self->{VERSION} !~ /^\s*v?[\d_\.]+\s*$/ ) {
2285 2         16 require version;
2286 2         15 my $normal = eval { version->new( $self->{VERSION} ) };
  2         42  
2287 2 50       25 $self->{VERSION} = $normal if defined $normal;
2288             }
2289 107         637 $self->{VERSION} =~ s/^\s+//;
2290 107         486 $self->{VERSION} =~ s/\s+$//;
2291             }
2292             else {
2293 48         169 $self->{VERSION} = '';
2294             }
2295              
2296              
2297 155         932 $self->{VERSION_MACRO} = 'VERSION';
2298 155         1466 ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g;
2299 155         476 $self->{DEFINE_VERSION} = '-D$(VERSION_MACRO)=\"$(VERSION)\"';
2300              
2301              
2302             # Graham Barr and Paul Marquess had some ideas how to ensure
2303             # version compatibility between the *.pm file and the
2304             # corresponding *.xs file. The bottom line was, that we need an
2305             # XS_VERSION macro that defaults to VERSION:
2306 155   66     1864 $self->{XS_VERSION} ||= $self->{VERSION};
2307              
2308 155         472 $self->{XS_VERSION_MACRO} = 'XS_VERSION';
2309 155         633 $self->{XS_DEFINE_VERSION} = '-D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"';
2310              
2311             }
2312              
2313              
2314             =head3 init_tools
2315              
2316             $MM->init_tools();
2317              
2318             Initializes the simple macro definitions used by tools_other() and
2319             places them in the $MM object. These use conservative cross platform
2320             versions and should be overridden with platform specific versions for
2321             performance.
2322              
2323             Defines at least these macros.
2324              
2325             Macro Description
2326              
2327             NOOP Do nothing
2328             NOECHO Tell make not to display the command itself
2329              
2330             SHELL Program used to run shell commands
2331              
2332             ECHO Print text adding a newline on the end
2333             RM_F Remove a file
2334             RM_RF Remove a directory
2335             TOUCH Update a file's timestamp
2336             TEST_F Test for a file's existence
2337             TEST_S Test the size of a file
2338             CP Copy a file
2339             CP_NONEMPTY Copy a file if it is not empty
2340             MV Move a file
2341             CHMOD Change permissions on a file
2342             FALSE Exit with non-zero
2343             TRUE Exit with zero
2344              
2345             UMASK_NULL Nullify umask
2346             DEV_NULL Suppress all command output
2347              
2348             =cut
2349              
2350             sub init_tools {
2351 156     156 1 557 my $self = shift;
2352              
2353 156   33     661 $self->{ECHO} ||= $self->oneliner('binmode STDOUT, qq{:raw}; print qq{@ARGV}', ['-l']);
2354 156   33     554 $self->{ECHO_N} ||= $self->oneliner('print qq{@ARGV}');
2355              
2356 156   33     514 $self->{TOUCH} ||= $self->oneliner('touch', ["-MExtUtils::Command"]);
2357 156   33     566 $self->{CHMOD} ||= $self->oneliner('chmod', ["-MExtUtils::Command"]);
2358 156   33     542 $self->{RM_F} ||= $self->oneliner('rm_f', ["-MExtUtils::Command"]);
2359 156   33     500 $self->{RM_RF} ||= $self->oneliner('rm_rf', ["-MExtUtils::Command"]);
2360 156   33     551 $self->{TEST_F} ||= $self->oneliner('test_f', ["-MExtUtils::Command"]);
2361 156   33     559 $self->{TEST_S} ||= $self->oneliner('test_s', ["-MExtUtils::Command::MM"]);
2362 156   33     6901 $self->{CP_NONEMPTY} ||= $self->oneliner('cp_nonempty', ["-MExtUtils::Command::MM"]);
2363 156   33     751 $self->{FALSE} ||= $self->oneliner('exit 1');
2364 156   33     5372 $self->{TRUE} ||= $self->oneliner('exit 0');
2365              
2366 156   33     3142 $self->{MKPATH} ||= $self->oneliner('mkpath', ["-MExtUtils::Command"]);
2367              
2368 156   33     838 $self->{CP} ||= $self->oneliner('cp', ["-MExtUtils::Command"]);
2369 156   33     634 $self->{MV} ||= $self->oneliner('mv', ["-MExtUtils::Command"]);
2370              
2371             $self->{MOD_INSTALL} ||=
2372 156   33     2536 $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
2373             install([ from_to => {@ARGV}, verbose => '$(VERBINST)', uninstall_shadows => '$(UNINST)', dir_mode => '$(PERM_DIR)' ]);
2374             CODE
2375 156   33     2139 $self->{DOC_INSTALL} ||= $self->oneliner('perllocal_install', ["-MExtUtils::Command::MM"]);
2376 156   33     1539 $self->{UNINSTALL} ||= $self->oneliner('uninstall', ["-MExtUtils::Command::MM"]);
2377             $self->{WARN_IF_OLD_PACKLIST} ||=
2378 156   33     2520 $self->oneliner('warn_if_old_packlist', ["-MExtUtils::Command::MM"]);
2379 156   33     2580 $self->{FIXIN} ||= $self->oneliner('MY->fixin(shift)', ["-MExtUtils::MY"]);
2380 156   33     2031 $self->{EQUALIZE_TIMESTAMP} ||= $self->oneliner('eqtime', ["-MExtUtils::Command"]);
2381              
2382 156   50     1653 $self->{UNINST} ||= 0;
2383 156   50     6821 $self->{VERBINST} ||= 0;
2384              
2385 156   33     2490 $self->{SHELL} ||= $Config{sh};
2386              
2387             # UMASK_NULL is not used by MakeMaker but some CPAN modules
2388             # make use of it.
2389 156   50     1345 $self->{UMASK_NULL} ||= "umask 0";
2390              
2391             # Not the greatest default, but its something.
2392 156   50     1764 $self->{DEV_NULL} ||= "> /dev/null 2>&1";
2393              
2394 156   50     1098 $self->{NOOP} ||= '$(TRUE)';
2395 156 50       1026 $self->{NOECHO} = '@' unless defined $self->{NOECHO};
2396              
2397 156   50     2460 $self->{FIRST_MAKEFILE} ||= $self->{MAKEFILE} || 'Makefile';
      66        
2398 156   33     2063 $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE};
2399 156   33     1887 $self->{MAKEFILE_OLD} ||= $self->{MAKEFILE}.'.old';
2400 156   33     1161 $self->{MAKE_APERL_FILE} ||= $self->{MAKEFILE}.'.aperl';
2401              
2402             # Not everybody uses -f to indicate "use this Makefile instead"
2403 156   50     942 $self->{USEMAKEFILE} ||= '-f';
2404              
2405             # Some makes require a wrapper around macros passed in on the command
2406             # line.
2407 156   50     959 $self->{MACROSTART} ||= '';
2408 156   50     1189 $self->{MACROEND} ||= '';
2409              
2410 156         700 return;
2411             }
2412              
2413              
2414             =head3 init_others
2415              
2416             $MM->init_others();
2417              
2418             Initializes the macro definitions having to do with compiling and
2419             linking used by tools_other() and places them in the $MM object.
2420              
2421             If there is no description, its the same as the parameter to
2422             WriteMakefile() documented in L<ExtUtils::MakeMaker>.
2423              
2424             =cut
2425              
2426             sub init_others {
2427 155     155 1 427 my $self = shift;
2428              
2429 155         1369 $self->{LD_RUN_PATH} = "";
2430              
2431 155         3003 $self->{LIBS} = $self->_fix_libs($self->{LIBS});
2432              
2433             # Compute EXTRALIBS, BSLOADLIBS and LDLOADLIBS from $self->{LIBS}
2434 154         698 foreach my $libs ( @{$self->{LIBS}} ){
  154         953  
2435 155         586 $libs =~ s/^\s*(.*\S)\s*$/$1/; # remove leading and trailing whitespace
2436 155         2648 my(@libs) = $self->extliblist($libs);
2437 155 50 33     3128 if ($libs[0] or $libs[1] or $libs[2]){
      33        
2438             # LD_RUN_PATH now computed by ExtUtils::Liblist
2439             ($self->{EXTRALIBS}, $self->{BSLOADLIBS},
2440 0         0 $self->{LDLOADLIBS}, $self->{LD_RUN_PATH}) = @libs;
2441 0         0 last;
2442             }
2443             }
2444              
2445 154 50 33     2693 if ( $self->{OBJECT} ) {
    50 33        
2446 0 0       0 $self->{OBJECT} = join(" ", @{$self->{OBJECT}}) if ref $self->{OBJECT};
  0         0  
2447 0         0 $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g;
2448 0 0       0 } elsif ( ($self->{MAGICXS} || $self->{XSMULTI}) && @{$self->{O_FILES}||[]} ) {
2449 0         0 $self->{OBJECT} = join(" ", @{$self->{O_FILES}});
  0         0  
2450 0         0 $self->{OBJECT} =~ s!\.o(bj)?\b!\$(OBJ_EXT)!g;
2451             } else {
2452             # init_dirscan should have found out, if we have C files
2453 154         1030 $self->{OBJECT} = "";
2454 154 50       530 $self->{OBJECT} = '$(BASEEXT)$(OBJ_EXT)' if @{$self->{C}||[]};
  154 50       1177  
2455             }
2456 154         589 $self->{OBJECT} =~ s/\n+/ \\\n\t/g;
2457              
2458 154 50       3586 $self->{BOOTDEP} = (-f "$self->{BASEEXT}_BS") ? "$self->{BASEEXT}_BS" : "";
2459 154   50     2512 $self->{PERLMAINCC} ||= '$(CC)';
2460 154 50       1593 $self->{LDFROM} = '$(OBJECT)' unless $self->{LDFROM};
2461              
2462             # Sanity check: don't define LINKTYPE = dynamic if we're skipping
2463             # the 'dynamic' section of MM. We don't have this problem with
2464             # 'static', since we either must use it (%Config says we can't
2465             # use dynamic loading) or the caller asked for it explicitly.
2466 154 100       864 if (!$self->{LINKTYPE}) {
2467             $self->{LINKTYPE} = $self->{SKIPHASH}{'dynamic'}
2468             ? 'static'
2469 97 50       1530 : ($Config{usedl} ? 'dynamic' : 'static');
    50          
2470             }
2471              
2472 154         745 return;
2473             }
2474              
2475              
2476             # Lets look at $self->{LIBS} carefully: It may be an anon array, a string or
2477             # undefined. In any case we turn it into an anon array
2478             sub _fix_libs {
2479 163     163   5225 my($self, $libs) = @_;
2480              
2481 163 100       2420 return !defined $libs ? [''] :
    100          
    100          
2482             !ref $libs ? [$libs] :
2483             !defined $libs->[0] ? [''] :
2484             $libs ;
2485             }
2486              
2487              
2488             =head3 tools_other
2489              
2490             my $make_frag = $MM->tools_other;
2491              
2492             Returns a make fragment containing definitions for the macros init_others()
2493             initializes.
2494              
2495             =cut
2496              
2497             sub tools_other {
2498 153     153 1 505 my($self) = shift;
2499 153         369 my @m;
2500              
2501             # We set PM_FILTER as late as possible so it can see all the earlier
2502             # on macro-order sensitive makes such as nmake.
2503 153         1169 for my $tool (qw{ SHELL CHMOD CP MV NOOP NOECHO RM_F RM_RF TEST_F TOUCH
2504             UMASK_NULL DEV_NULL MKPATH EQUALIZE_TIMESTAMP
2505             FALSE TRUE
2506             ECHO ECHO_N
2507             UNINST VERBINST
2508             MOD_INSTALL DOC_INSTALL UNINSTALL
2509             WARN_IF_OLD_PACKLIST
2510             MACROSTART MACROEND
2511             USEMAKEFILE
2512             PM_FILTER
2513             FIXIN
2514             CP_NONEMPTY
2515             } )
2516             {
2517 4590 100       10060 next unless defined $self->{$tool};
2518 4437         11110 push @m, "$tool = $self->{$tool}\n";
2519             }
2520              
2521 153         2082 return join "", @m;
2522             }
2523              
2524              
2525             =head3 init_DIRFILESEP I<Abstract>
2526              
2527             $MM->init_DIRFILESEP;
2528             my $dirfilesep = $MM->{DIRFILESEP};
2529              
2530             Initializes the DIRFILESEP macro which is the separator between the
2531             directory and filename in a filepath. ie. / on Unix, \ on Win32 and
2532             nothing on VMS.
2533              
2534             For example:
2535              
2536             # instead of $(INST_ARCHAUTODIR)/extralibs.ld
2537             $(INST_ARCHAUTODIR)$(DIRFILESEP)extralibs.ld
2538              
2539             Something of a hack but it prevents a lot of code duplication between
2540             MM_* variants.
2541              
2542             Do not use this as a separator between directories. Some operating
2543             systems use different separators between subdirectories as between
2544             directories and filenames (for example: VOLUME:[dir1.dir2]file on VMS).
2545              
2546             =head3 init_linker I<Abstract>
2547              
2548             $mm->init_linker;
2549              
2550             Initialize macros which have to do with linking.
2551              
2552             PERL_ARCHIVE: path to libperl.a equivalent to be linked to dynamic
2553             extensions.
2554              
2555             PERL_ARCHIVE_AFTER: path to a library which should be put on the
2556             linker command line I<after> the external libraries to be linked to
2557             dynamic extensions. This may be needed if the linker is one-pass, and
2558             Perl includes some overrides for C RTL functions, such as malloc().
2559              
2560             EXPORT_LIST: name of a file that is passed to linker to define symbols
2561             to be exported.
2562              
2563             Some OSes do not need these in which case leave it blank.
2564              
2565              
2566             =head3 init_platform
2567              
2568             $mm->init_platform
2569              
2570             Initialize any macros which are for platform specific use only.
2571              
2572             A typical one is the version number of your OS specific module.
2573             (ie. MM_Unix_VERSION or MM_VMS_VERSION).
2574              
2575             =cut
2576              
2577             sub init_platform {
2578 0     0 1 0 return '';
2579             }
2580              
2581              
2582             =head3 init_MAKE
2583              
2584             $mm->init_MAKE
2585              
2586             Initialize MAKE from either a MAKE environment variable or $Config{make}.
2587              
2588             =cut
2589              
2590             sub init_MAKE {
2591 155     155 1 485 my $self = shift;
2592              
2593 155   33     2854 $self->{MAKE} ||= $ENV{MAKE} || $Config{make};
      33        
2594             }
2595              
2596              
2597             =head2 Tools
2598              
2599             A grab bag of methods to generate specific macros and commands.
2600              
2601              
2602              
2603             =head3 manifypods
2604              
2605             Defines targets and routines to translate the pods into manpages and
2606             put them into the INST_* directories.
2607              
2608             =cut
2609              
2610             sub manifypods {
2611 153     153 1 412 my $self = shift;
2612              
2613 153         2028 my $POD2MAN_macro = $self->POD2MAN_macro();
2614 153         1817 my $manifypods_target = $self->manifypods_target();
2615              
2616 153         996 return <<END_OF_TARGET;
2617              
2618             $POD2MAN_macro
2619              
2620             $manifypods_target
2621              
2622             END_OF_TARGET
2623              
2624             }
2625              
2626              
2627             =head3 POD2MAN_macro
2628              
2629             my $pod2man_macro = $self->POD2MAN_macro
2630              
2631             Returns a definition for the POD2MAN macro. This is a program
2632             which emulates the pod2man utility. You can add more switches to the
2633             command by simply appending them on the macro.
2634              
2635             Typical usage:
2636              
2637             $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) podfile1 man_page1 ...
2638              
2639             =cut
2640              
2641             sub POD2MAN_macro {
2642 153     153 1 510 my $self = shift;
2643              
2644             # Need the trailing '--' so perl stops gobbling arguments and - happens
2645             # to be an alternative end of line separator on VMS so we quote it
2646 153         896 return <<'END_OF_DEF';
2647             POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
2648             POD2MAN = $(POD2MAN_EXE)
2649             END_OF_DEF
2650             }
2651              
2652              
2653             =head3 test_via_harness
2654              
2655             my $command = $mm->test_via_harness($perl, $tests);
2656              
2657             Returns a $command line which runs the given set of $tests with
2658             Test::Harness and the given $perl.
2659              
2660             Used on the t/*.t files.
2661              
2662             =cut
2663              
2664             sub test_via_harness {
2665 226     226 1 640 my($self, $perl, $tests) = @_;
2666              
2667 226         1285 return qq{\t$perl "-MExtUtils::Command::MM" "-MTest::Harness" }.
2668             qq{"-e" "undef *Test::Harness::Switches; test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n};
2669             }
2670              
2671             =head3 test_via_script
2672              
2673             my $command = $mm->test_via_script($perl, $script);
2674              
2675             Returns a $command line which just runs a single test without
2676             Test::Harness. No checks are done on the results, they're just
2677             printed.
2678              
2679             Used for test.pl, since they don't always follow Test::Harness
2680             formatting.
2681              
2682             =cut
2683              
2684             sub test_via_script {
2685 338     338 1 826 my($self, $perl, $script) = @_;
2686 338         1369 return qq{\t$perl "-I\$(INST_LIB)" "-I\$(INST_ARCHLIB)" $script\n};
2687             }
2688              
2689              
2690             =head3 tool_autosplit
2691              
2692             Defines a simple perl call that runs autosplit. May be deprecated by
2693             pm_to_blib soon.
2694              
2695             =cut
2696              
2697             sub tool_autosplit {
2698 153     153 1 597 my($self, %attribs) = @_;
2699              
2700 153 50       1131 my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};'
2701             : '';
2702              
2703 153         1429 my $asplit = $self->oneliner(sprintf <<'PERL_CODE', $maxlen);
2704             use AutoSplit; %s autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)
2705             PERL_CODE
2706              
2707 153         1303 return sprintf <<'MAKE_FRAG', $asplit;
2708             # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
2709             AUTOSPLITFILE = %s
2710              
2711             MAKE_FRAG
2712              
2713             }
2714              
2715              
2716             =head3 arch_check
2717              
2718             my $arch_ok = $mm->arch_check(
2719             $INC{"Config.pm"},
2720             File::Spec->catfile($Config{archlibexp}, "Config.pm")
2721             );
2722              
2723             A sanity check that what Perl thinks the architecture is and what
2724             Config thinks the architecture is are the same. If they're not it
2725             will return false and show a diagnostic message.
2726              
2727             When building Perl it will always return true, as nothing is installed
2728             yet.
2729              
2730             The interface is a bit odd because this is the result of a
2731             quick refactoring. Don't rely on it.
2732              
2733             =cut
2734              
2735             sub arch_check {
2736 159     159 1 670 my $self = shift;
2737 159         1079 my($pconfig, $cconfig) = @_;
2738              
2739 159 100       800 return 1 if $self->{PERL_SRC};
2740              
2741 158         7364 my($pvol, $pthinks) = $self->splitpath($pconfig);
2742 158         2674 my($cvol, $cthinks) = $self->splitpath($cconfig);
2743              
2744 158         1045 $pthinks = $self->canonpath($pthinks);
2745 158         749 $cthinks = $self->canonpath($cthinks);
2746              
2747 158         865 my $ret = 1;
2748 158 100       679 if ($pthinks ne $cthinks) {
2749 2         12 print "Have $pthinks\n";
2750 2         14 print "Want $cthinks\n";
2751              
2752 2         11 $ret = 0;
2753              
2754 2         22 my $arch = (grep length, $self->splitdir($pthinks))[-1];
2755              
2756 2 100       13 print <<END unless $self->{UNINSTALLED_PERL};
2757             Your perl and your Config.pm seem to have different ideas about the
2758             architecture they are running on.
2759             Perl thinks: [$arch]
2760             Config says: [$Config{archname}]
2761             This may or may not cause problems. Please check your installation of perl
2762             if you have problems building this extension.
2763             END
2764             }
2765              
2766 158         581 return $ret;
2767             }
2768              
2769              
2770              
2771             =head2 File::Spec wrappers
2772              
2773             ExtUtils::MM_Any is a subclass of L<File::Spec>. The methods noted here
2774             override File::Spec.
2775              
2776              
2777              
2778             =head3 catfile
2779              
2780             File::Spec <= 0.83 has a bug where the file part of catfile is not
2781             canonicalized. This override fixes that bug.
2782              
2783             =cut
2784              
2785             sub catfile {
2786 3780     3780 1 12547 my $self = shift;
2787 3780         71812 return $self->canonpath($self->SUPER::catfile(@_));
2788             }
2789              
2790              
2791              
2792             =head2 Misc
2793              
2794             Methods I can't really figure out where they should go yet.
2795              
2796              
2797             =head3 find_tests
2798              
2799             my $test = $mm->find_tests;
2800              
2801             Returns a string suitable for feeding to the shell to return all
2802             tests in t/*.t.
2803              
2804             =cut
2805              
2806             sub find_tests {
2807 113     113 1 325 my($self) = shift;
2808 113 50       1690 return -d 't' ? 't/*.t' : '';
2809             }
2810              
2811             =head3 find_tests_recursive
2812              
2813             my $tests = $mm->find_tests_recursive;
2814              
2815             Returns a string suitable for feeding to the shell to return all
2816             tests in t/ but recursively. Equivalent to
2817              
2818             my $tests = $mm->find_tests_recursive_in('t');
2819              
2820             =cut
2821              
2822             sub find_tests_recursive {
2823 0     0 1 0 my $self = shift;
2824 0         0 return $self->find_tests_recursive_in('t');
2825             }
2826              
2827             =head3 find_tests_recursive_in
2828              
2829             my $tests = $mm->find_tests_recursive_in($dir);
2830              
2831             Returns a string suitable for feeding to the shell to return all
2832             tests in $dir recursively.
2833              
2834             =cut
2835              
2836             sub find_tests_recursive_in {
2837 0     0 1 0 my($self, $dir) = @_;
2838 0 0       0 return '' unless -d $dir;
2839              
2840 0         0 require File::Find;
2841              
2842 0         0 my $base_depth = grep { $_ ne '' } File::Spec->splitdir( (File::Spec->splitpath($dir))[1] );
  0         0  
2843 0         0 my %depths;
2844              
2845             my $wanted = sub {
2846 0 0   0   0 return unless m!\.t$!;
2847 0         0 my ($volume,$directories,$file) =
2848             File::Spec->splitpath( $File::Find::name );
2849 0         0 my $depth = grep { $_ ne '' } File::Spec->splitdir( $directories );
  0         0  
2850 0         0 $depth -= $base_depth;
2851 0         0 $depths{ $depth } = 1;
2852 0         0 };
2853              
2854 0         0 File::Find::find( $wanted, $dir );
2855              
2856             return join ' ',
2857 0         0 map { $dir . '/*' x $_ . '.t' }
2858 0         0 sort { $a <=> $b }
  0         0  
2859             keys %depths;
2860             }
2861              
2862             =head3 extra_clean_files
2863              
2864             my @files_to_clean = $MM->extra_clean_files;
2865              
2866             Returns a list of OS specific files to be removed in the clean target in
2867             addition to the usual set.
2868              
2869             =cut
2870              
2871             # An empty method here tickled a perl 5.8.1 bug and would return its object.
2872             sub extra_clean_files {
2873 153     153 1 401 return;
2874             }
2875              
2876              
2877             =head3 installvars
2878              
2879             my @installvars = $mm->installvars;
2880              
2881             A list of all the INSTALL* variables without the INSTALL prefix. Useful
2882             for iteration or building related variable sets.
2883              
2884             =cut
2885              
2886             sub installvars {
2887 309     309 1 3790 return qw(PRIVLIB SITELIB VENDORLIB
2888             ARCHLIB SITEARCH VENDORARCH
2889             BIN SITEBIN VENDORBIN
2890             SCRIPT SITESCRIPT VENDORSCRIPT
2891             MAN1DIR SITEMAN1DIR VENDORMAN1DIR
2892             MAN3DIR SITEMAN3DIR VENDORMAN3DIR
2893             );
2894             }
2895              
2896              
2897             =head3 libscan
2898              
2899             my $wanted = $self->libscan($path);
2900              
2901             Takes a path to a file or dir and returns an empty string if we don't
2902             want to include this file in the library. Otherwise it returns the
2903             the $path unchanged.
2904              
2905             Mainly used to exclude version control administrative directories
2906             and base-level F<README.pod> from installation.
2907              
2908             =cut
2909              
2910             sub libscan {
2911 1022     1022 1 2789 my($self,$path) = @_;
2912              
2913 1022 100       3036 if ($path =~ m<^README\.pod$>i) {
2914 6         62 warn "WARNING: Older versions of ExtUtils::MakeMaker may errantly install $path as part of this distribution. It is recommended to avoid using this path in CPAN modules.\n";
2915 6         55 return '';
2916             }
2917              
2918 1016         14824 my($dirs,$file) = ($self->splitpath($path))[1,2];
2919 1016 100       8864 return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/,
2920             $self->splitdir($dirs), $file;
2921              
2922 1012         3562 return $path;
2923             }
2924              
2925              
2926             =head3 platform_constants
2927              
2928             my $make_frag = $mm->platform_constants
2929              
2930             Returns a make fragment defining all the macros initialized in
2931             init_platform() rather than put them in constants().
2932              
2933             =cut
2934              
2935             sub platform_constants {
2936 0     0 1 0 return '';
2937             }
2938              
2939             =head3 post_constants (o)
2940              
2941             Returns an empty string per default. Dedicated to overrides from
2942             within Makefile.PL after all constants have been defined.
2943              
2944             =cut
2945              
2946             sub post_constants {
2947 154     154 1 614 "";
2948             }
2949              
2950             =head3 post_initialize (o)
2951              
2952             Returns an empty string per default. Used in Makefile.PLs to add some
2953             chunk of text to the Makefile after the object is initialized.
2954              
2955             =cut
2956              
2957             sub post_initialize {
2958 155     155 1 2970 "";
2959             }
2960              
2961             =head3 postamble (o)
2962              
2963             Returns an empty string. Can be used in Makefile.PLs to write some
2964             text to the Makefile at the end.
2965              
2966             =cut
2967              
2968             sub postamble {
2969 153     153 1 1043 "";
2970             }
2971              
2972             =begin private
2973              
2974             =head3 _PREREQ_PRINT
2975              
2976             $self->_PREREQ_PRINT;
2977              
2978             Implements PREREQ_PRINT.
2979              
2980             Refactored out of MakeMaker->new().
2981              
2982             =end private
2983              
2984             =cut
2985              
2986             sub _PREREQ_PRINT {
2987 0     0     my $self = shift;
2988              
2989 0           require Data::Dumper;
2990 0           my @what = ('PREREQ_PM');
2991 0 0         push @what, 'MIN_PERL_VERSION' if $self->{MIN_PERL_VERSION};
2992 0 0         push @what, 'BUILD_REQUIRES' if $self->{BUILD_REQUIRES};
2993 0           print Data::Dumper->Dump([@{$self}{@what}], \@what);
  0            
2994 0           exit 0;
2995             }
2996              
2997              
2998             =begin private
2999              
3000             =head3 _PRINT_PREREQ
3001              
3002             $mm->_PRINT_PREREQ;
3003              
3004             Implements PRINT_PREREQ, a slightly different version of PREREQ_PRINT
3005             added by Redhat to, I think, support generating RPMs from Perl modules.
3006              
3007             Should not include BUILD_REQUIRES as RPMs do not include them.
3008              
3009             Refactored out of MakeMaker->new().
3010              
3011             =end private
3012              
3013             =cut
3014              
3015             sub _PRINT_PREREQ {
3016 0     0     my $self = shift;
3017              
3018 0           my $prereqs= $self->{PREREQ_PM};
3019 0           my @prereq = map { [$_, $prereqs->{$_}] } keys %$prereqs;
  0            
3020              
3021 0 0         if ( $self->{MIN_PERL_VERSION} ) {
3022 0           push @prereq, ['perl' => $self->{MIN_PERL_VERSION}];
3023             }
3024              
3025 0           print join(" ", map { "perl($_->[0])>=$_->[1] " }
3026 0           sort { $a->[0] cmp $b->[0] } @prereq), "\n";
  0            
3027 0           exit 0;
3028             }
3029              
3030              
3031             =begin private
3032              
3033             =head3 _perl_header_files
3034              
3035             my $perl_header_files= $self->_perl_header_files;
3036              
3037             returns a sorted list of header files as found in PERL_SRC or $archlibexp/CORE.
3038              
3039             Used by perldepend() in MM_Unix and MM_VMS via _perl_header_files_fragment()
3040              
3041             =end private
3042              
3043             =cut
3044              
3045             sub _perl_header_files {
3046 0     0     my $self = shift;
3047              
3048 0   0       my $header_dir = $self->{PERL_SRC} || $ENV{PERL_SRC} || $self->catdir($Config{archlibexp}, 'CORE');
3049 0 0         opendir my $dh, $header_dir
3050             or die "Failed to opendir '$header_dir' to find header files: $!";
3051              
3052             # we need to use a temporary here as the sort in scalar context would have undefined results.
3053 0           my @perl_headers= sort grep { /\.h\z/ } readdir($dh);
  0            
3054              
3055 0           closedir $dh;
3056              
3057 0           return @perl_headers;
3058             }
3059              
3060             =begin private
3061              
3062             =head3 _perl_header_files_fragment ($o, $separator)
3063              
3064             my $perl_header_files_fragment= $self->_perl_header_files_fragment("/");
3065              
3066             return a Makefile fragment which holds the list of perl header files which
3067             XS code depends on $(PERL_INC), and sets up the dependency for the $(OBJECT) file.
3068              
3069             The $separator argument defaults to "". MM_VMS will set it to "" and MM_UNIX to "/"
3070             in perldepend(). This reason child subclasses need to control this is that in
3071             VMS the $(PERL_INC) directory will already have delimiters in it, but in
3072             UNIX $(PERL_INC) will need a slash between it an the filename. Hypothetically
3073             win32 could use "\\" (but it doesn't need to).
3074              
3075             =end private
3076              
3077             =cut
3078              
3079             sub _perl_header_files_fragment {
3080 0     0     my ($self, $separator)= @_;
3081 0   0       $separator ||= "";
3082             return join("\\\n",
3083             "PERL_HDRS = ",
3084             map {
3085 0           sprintf( " \$(PERL_INCDEP)%s%s ", $separator, $_ )
  0            
3086             } $self->_perl_header_files()
3087             ) . "\n\n"
3088             . "\$(OBJECT) : \$(PERL_HDRS)\n";
3089             }
3090              
3091              
3092             =head1 AUTHOR
3093              
3094             Michael G Schwern <schwern@pobox.com> and the denizens of
3095             makemaker@perl.org with code from ExtUtils::MM_Unix and
3096             ExtUtils::MM_Win32.
3097              
3098              
3099             =cut
3100              
3101             1;