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