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