File Coverage

lib/ExtUtils/MM_Any.pm
Criterion Covered Total %
statement 648 791 81.9
branch 231 350 66.0
condition 152 299 50.8
subroutine 85 102 83.3
pod 69 73 94.5
total 1185 1615 73.3


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