lib/ExtUtils/MM_Any.pm

   1 package ExtUtils::MM_Any;
   2
   3 use strict;
   4 our $VERSION = '6.46';
   5
   6 use Carp;
   7 use File::Spec;
   8 BEGIN { our @ISA = qw(File::Spec); }
   9
  10 # We need $Verbose
  11 use ExtUtils::MakeMaker qw($Verbose);
  12
  13 use ExtUtils::MakeMaker::Config;
  14
  15
  16 # So we don't have to keep calling the methods over and over again,
  17 # we have these globals to cache the values.  Faster and shrtr.
  18 my $Curdir  = __PACKAGE__->curdir;
  19 my $Rootdir = __PACKAGE__->rootdir;
  20 my $Updir   = __PACKAGE__->updir;
  21
  22
  23 =head1 NAME
  24
  25 ExtUtils::MM_Any - Platform-agnostic MM methods
  26
  27 =head1 SYNOPSIS
  28
  29   FOR INTERNAL USE ONLY!
  30
  31   package ExtUtils::MM_SomeOS;
  32
  33   # Temporarily, you have to subclass both.  Put MM_Any first.
  34   require ExtUtils::MM_Any;
  35   require ExtUtils::MM_Unix;
  36   @ISA = qw(ExtUtils::MM_Any ExtUtils::Unix);
  37
  38 =head1 DESCRIPTION
  39
  40 B<FOR INTERNAL USE ONLY!>
  41
  42 ExtUtils::MM_Any is a superclass for the ExtUtils::MM_* set of
  43 modules.  It contains methods which are either inherently
  44 cross-platform or are written in a cross-platform manner.
  45
  46 Subclass off of ExtUtils::MM_Any I<and> ExtUtils::MM_Unix.  This is a
  47 temporary solution.
  48
  49 B<THIS MAY BE TEMPORARY!>
  50
  51
  52 =head1 METHODS
  53
  54 Any methods marked I<Abstract> must be implemented by subclasses.
  55
  56
  57 =head2 Cross-platform helper methods
  58
  59 These are methods which help writing cross-platform code.
  60
  61
  62
  63 =head3 os_flavor  I<Abstract>
  64
  65     my @os_flavor = $mm->os_flavor;
  66
  67 @os_flavor is the style of operating system this is, usually
  68 corresponding to the MM_*.pm file we're using.
  69
  70 The first element of @os_flavor is the major family (ie. Unix,
  71 Windows, VMS, OS/2, etc...) and the rest are sub families.
  72
  73 Some examples:
  74
  75     Cygwin98       ('Unix',  'Cygwin', 'Cygwin9x')
  76     Windows NT     ('Win32', 'WinNT')
  77     Win98          ('Win32', 'Win9x')
  78     Linux          ('Unix',  'Linux')
  79     MacOS X        ('Unix',  'Darwin', 'MacOS', 'MacOS X')
  80     OS/2           ('OS/2')
  81
  82 This is used to write code for styles of operating system.
  83 See os_flavor_is() for use.
  84
  85
  86 =head3 os_flavor_is
  87
  88     my $is_this_flavor = $mm->os_flavor_is($this_flavor);
  89     my $is_this_flavor = $mm->os_flavor_is(@one_of_these_flavors);
  90
  91 Checks to see if the current operating system is one of the given flavors.
  92
  93 This is useful for code like:
  94
  95     if( $mm->os_flavor_is('Unix') ) {
  96         $out = `foo 2>&1`;
  97     }
  98     else {
  99         $out = `foo`;
 100     }
 101
 102 =cut
 103
 104 sub os_flavor_is {
 105     my $self = shift;
 106     my %flavors = map { ($_ => 1) } $self->os_flavor;
 107     return (grep { $flavors{$_} } @_) ? 1 : 0;
 108 }
 109
 110
 111 =head3 split_command
 112
 113     my @cmds = $MM->split_command($cmd, @args);
 114
 115 Most OS have a maximum command length they can execute at once.  Large
 116 modules can easily generate commands well past that limit.  Its
 117 necessary to split long commands up into a series of shorter commands.
 118
 119 C<split_command> will return a series of @cmds each processing part of
 120 the args.  Collectively they will process all the arguments.  Each
 121 individual line in @cmds will not be longer than the
 122 $self->max_exec_len being careful to take into account macro expansion.
 123
 124 $cmd should include any switches and repeated initial arguments.
 125
 126 If no @args are given, no @cmds will be returned.
 127
 128 Pairs of arguments will always be preserved in a single command, this
 129 is a heuristic for things like pm_to_blib and pod2man which work on
 130 pairs of arguments.  This makes things like this safe:
 131
 132     $self->split_command($cmd, %pod2man);
 133
 134
 135 =cut
 136
 137 sub split_command {
 138     my($self, $cmd, @args) = @_;
 139
 140     my @cmds = ();
 141     return(@cmds) unless @args;
 142
 143     # If the command was given as a here-doc, there's probably a trailing
 144     # newline.
 145     chomp $cmd;
 146
 147     # set aside 30% for macro expansion.
 148     my $len_left = int($self->max_exec_len * 0.70);
 149     $len_left -= length $self->_expand_macros($cmd);
 150
 151     do {
 152         my $arg_str = '';
 153         my @next_args;
 154         while( @next_args = splice(@args, 0, 2) ) {
 155             # Two at a time to preserve pairs.
 156             my $next_arg_str = "\t  ". join ' ', @next_args, "\n";
 157
 158             if( !length $arg_str ) {
 159                 $arg_str .= $next_arg_str
 160             }
 161             elsif( length($arg_str) + length($next_arg_str) > $len_left ) {
 162                 unshift @args, @next_args;
 163                 last;
 164             }
 165             else {
 166                 $arg_str .= $next_arg_str;
 167             }
 168         }
 169         chop $arg_str;
 170
 171         push @cmds, $self->escape_newlines("$cmd \n$arg_str");
 172     } while @args;
 173
 174     return @cmds;
 175 }
 176
 177
 178 sub _expand_macros {
 179     my($self, $cmd) = @_;
 180
 181     $cmd =~ s{\$\((\w+)\)}{
 182         defined $self->{$1} ? $self->{$1} : "\$($1)"
 183     }e;
 184     return $cmd;
 185 }
 186
 187
 188 =head3 echo
 189
 190     my @commands = $MM->echo($text);
 191     my @commands = $MM->echo($text, $file);
 192     my @commands = $MM->echo($text, $file, $appending);
 193
 194 Generates a set of @commands which print the $text to a $file.
 195
 196 If $file is not given, output goes to STDOUT.
 197
 198 If $appending is true the $file will be appended to rather than
 199 overwritten.
 200
 201 =cut
 202
 203 sub echo {
 204     my($self, $text, $file, $appending) = @_;
 205     $appending ||= 0;
 206
 207     my @cmds = map { '$(NOECHO) $(ECHO) '.$self->quote_literal($_) }
 208                split /\n/, $text;
 209     if( $file ) {
 210         my $redirect = $appending ? '>>' : '>';
 211         $cmds[0] .= " $redirect $file";
 212         $_ .= " >> $file" foreach @cmds[1..$#cmds];
 213     }
 214
 215     return @cmds;
 216 }
 217
 218
 219 =head3 wraplist
 220
 221   my $args = $mm->wraplist(@list);
 222
 223 Takes an array of items and turns them into a well-formatted list of
 224 arguments.  In most cases this is simply something like:
 225
 226     FOO \
 227     BAR \
 228     BAZ
 229
 230 =cut
 231
 232 sub wraplist {
 233     my $self = shift;
 234     return join " \\\n\t", @_;
 235 }
 236
 237
 238 =head3 maketext_filter
 239
 240     my $filter_make_text = $mm->maketext_filter($make_text);
 241
 242 The text of the Makefile is run through this method before writing to
 243 disk.  It allows systems a chance to make portability fixes to the
 244 Makefile.
 245
 246 By default it does nothing.
 247
 248 This method is protected and not intended to be called outside of
 249 MakeMaker.
 250
 251 =cut
 252
 253 sub maketext_filter { return $_[1] }
 254
 255
 256 =head3 cd  I<Abstract>
 257
 258   my $subdir_cmd = $MM->cd($subdir, @cmds);
 259
 260 This will generate a make fragment which runs the @cmds in the given
 261 $dir.  The rough equivalent to this, except cross platform.
 262
 263   cd $subdir && $cmd
 264
 265 Currently $dir can only go down one level.  "foo" is fine.  "foo/bar" is
 266 not.  "../foo" is right out.
 267
 268 The resulting $subdir_cmd has no leading tab nor trailing newline.  This
 269 makes it easier to embed in a make string.  For example.
 270
 271       my $make = sprintf <<'CODE', $subdir_cmd;
 272   foo :
 273       $(ECHO) what
 274       %s
 275       $(ECHO) mouche
 276   CODE
 277
 278
 279 =head3 oneliner  I<Abstract>
 280
 281   my $oneliner = $MM->oneliner($perl_code);
 282   my $oneliner = $MM->oneliner($perl_code, \@switches);
 283
 284 This will generate a perl one-liner safe for the particular platform
 285 you're on based on the given $perl_code and @switches (a -e is
 286 assumed) suitable for using in a make target.  It will use the proper
 287 shell quoting and escapes.
 288
 289 $(PERLRUN) will be used as perl.
 290
 291 Any newlines in $perl_code will be escaped.  Leading and trailing
 292 newlines will be stripped.  Makes this idiom much easier:
 293
 294     my $code = $MM->oneliner(<<'CODE', [...switches...]);
 295 some code here
 296 another line here
 297 CODE
 298
 299 Usage might be something like:
 300
 301     # an echo emulation
 302     $oneliner = $MM->oneliner('print "Foo\n"');
 303     $make = '$oneliner > somefile';
 304
 305 All dollar signs must be doubled in the $perl_code if you expect them
 306 to be interpreted normally, otherwise it will be considered a make
 307 macro.  Also remember to quote make macros else it might be used as a
 308 bareword.  For example:
 309
 310     # Assign the value of the $(VERSION_FROM) make macro to $vf.
 311     $oneliner = $MM->oneliner('$$vf = "$(VERSION_FROM)"');
 312
 313 Its currently very simple and may be expanded sometime in the figure
 314 to include more flexible code and switches.
 315
 316
 317 =head3 quote_literal  I<Abstract>
 318
 319     my $safe_text = $MM->quote_literal($text);
 320
 321 This will quote $text so it is interpreted literally in the shell.
 322
 323 For example, on Unix this would escape any single-quotes in $text and
 324 put single-quotes around the whole thing.
 325
 326
 327 =head3 escape_newlines  I<Abstract>
 328
 329     my $escaped_text = $MM->escape_newlines($text);
 330
 331 Shell escapes newlines in $text.
 332
 333
 334 =head3 max_exec_len  I<Abstract>
 335
 336     my $max_exec_len = $MM->max_exec_len;
 337
 338 Calculates the maximum command size the OS can exec.  Effectively,
 339 this is the max size of a shell command line.
 340
 341 =for _private
 342 $self->{_MAX_EXEC_LEN} is set by this method, but only for testing purposes.
 343
 344
 345 =head3 make
 346
 347     my $make = $MM->make;
 348
 349 Returns the make variant we're generating the Makefile for.  This attempts
 350 to do some normalization on the information from %Config or the user.
 351
 352 =cut
 353
 354 sub make {
 355     my $self = shift;
 356
 357     my $make = lc $self->{MAKE};
 358
 359     # Truncate anything like foomake6 to just foomake.
 360     $make =~ s/^(\w+make).*/$1/;
 361
 362     # Turn gnumake into gmake.
 363     $make =~ s/^gnu/g/;
 364
 365     return $make;
 366 }
 367
 368
 369 =head2 Targets
 370
 371 These are methods which produce make targets.
 372
 373
 374 =head3 all_target
 375
 376 Generate the default target 'all'.
 377
 378 =cut
 379
 380 sub all_target {
 381     my $self = shift;
 382
 383     return <<'MAKE_EXT';
 384 all :: pure_all
 385         $(NOECHO) $(NOOP)
 386 MAKE_EXT
 387
 388 }
 389
 390
 391 =head3 blibdirs_target
 392
 393     my $make_frag = $mm->blibdirs_target;
 394
 395 Creates the blibdirs target which creates all the directories we use
 396 in blib/.
 397
 398 The blibdirs.ts target is deprecated.  Depend on blibdirs instead.
 399
 400
 401 =cut
 402
 403 sub blibdirs_target {
 404     my $self = shift;
 405
 406     my @dirs = map { uc "\$(INST_$_)" } qw(libdir archlib
 407                                            autodir archautodir
 408                                            bin script
 409                                            man1dir man3dir
 410                                           );
 411
 412     my @exists = map { $_.'$(DFSEP).exists' } @dirs;
 413
 414     my $make = sprintf <<'MAKE', join(' ', @exists);
 415 blibdirs : %s
 416         $(NOECHO) $(NOOP)
 417
 418 # Backwards compat with 6.18 through 6.25
 419 blibdirs.ts : blibdirs
 420         $(NOECHO) $(NOOP)
 421
 422 MAKE
 423
 424     $make .= $self->dir_target(@dirs);
 425
 426     return $make;
 427 }
 428
 429
 430 =head3 clean (o)
 431
 432 Defines the clean target.
 433
 434 =cut
 435
 436 sub clean {
 437 # --- Cleanup and Distribution Sections ---
 438
 439     my($self, %attribs) = @_;
 440     my @m;
 441     push(@m, '
 442 # Delete temporary files but do not touch installed files. We don\'t delete
 443 # the Makefile here so a later make realclean still has a makefile to use.
 444
 445 clean :: clean_subdirs
 446 ');
 447
 448     my @files = values %{$self->{XS}}; # .c files from *.xs files
 449     my @dirs  = qw(blib);
 450
 451     # Normally these are all under blib but they might have been
 452     # redefined.
 453     # XXX normally this would be a good idea, but the Perl core sets
 454     # INST_LIB = ../../lib rather than actually installing the files.
 455     # So a "make clean" in an ext/ directory would blow away lib.
 456     # Until the core is adjusted let's leave this out.
 457 #     push @dirs, qw($(INST_ARCHLIB) $(INST_LIB)
 458 #                    $(INST_BIN) $(INST_SCRIPT)
 459 #                    $(INST_MAN1DIR) $(INST_MAN3DIR)
 460 #                    $(INST_LIBDIR) $(INST_ARCHLIBDIR) $(INST_AUTODIR)
 461 #                    $(INST_STATIC) $(INST_DYNAMIC) $(INST_BOOT)
 462 #                 );
 463
 464
 465     if( $attribs{FILES} ) {
 466         # Use @dirs because we don't know what's in here.
 467         push @dirs, ref $attribs{FILES}                ?
 468                         @{$attribs{FILES}}             :
 469                         split /\s+/, $attribs{FILES}   ;
 470     }
 471
 472     push(@files, qw[$(MAKE_APERL_FILE)
 473                     perlmain.c tmon.out mon.out so_locations
 474                     blibdirs.ts pm_to_blib pm_to_blib.ts
 475                     *$(OBJ_EXT) *$(LIB_EXT) perl.exe perl perl$(EXE_EXT)
 476                     $(BOOTSTRAP) $(BASEEXT).bso
 477                     $(BASEEXT).def lib$(BASEEXT).def
 478                     $(BASEEXT).exp $(BASEEXT).x
 479                    ]);
 480
 481     push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
 482     push(@files, $self->catfile('$(INST_ARCHAUTODIR)','extralibs.ld'));
 483
 484     # core files
 485     push(@files, qw[core core.*perl.*.? *perl.core]);
 486     push(@files, map { "core." . "[0-9]"x$_ } (1..5));
 487
 488     # OS specific things to clean up.  Use @dirs since we don't know
 489     # what might be in here.
 490     push @dirs, $self->extra_clean_files;
 491
 492     # Occasionally files are repeated several times from different sources
 493     { my(%f) = map { ($_ => 1) } @files; @files = keys %f; }
 494     { my(%d) = map { ($_ => 1) } @dirs;  @dirs  = keys %d; }
 495
 496     push @m, map "\t$_\n", $self->split_command('- $(RM_F)',  @files);
 497     push @m, map "\t$_\n", $self->split_command('- $(RM_RF)', @dirs);
 498
 499     # Leave Makefile.old around for realclean
 500     push @m, <<'MAKE';
 501         - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
 502 MAKE
 503
 504     push(@m, "\t$attribs{POSTOP}\n")   if $attribs{POSTOP};
 505
 506     join("", @m);
 507 }
 508
 509
 510 =head3 clean_subdirs_target
 511
 512   my $make_frag = $MM->clean_subdirs_target;
 513
 514 Returns the clean_subdirs target.  This is used by the clean target to
 515 call clean on any subdirectories which contain Makefiles.
 516
 517 =cut
 518
 519 sub clean_subdirs_target {
 520     my($self) = shift;
 521
 522     # No subdirectories, no cleaning.
 523     return <<'NOOP_FRAG' unless @{$self->{DIR}};
 524 clean_subdirs :
 525         $(NOECHO) $(NOOP)
 526 NOOP_FRAG
 527
 528
 529     my $clean = "clean_subdirs :\n";
 530
 531     for my $dir (@{$self->{DIR}}) {
 532         my $subclean = $self->oneliner(sprintf <<'CODE', $dir);
 533 chdir '%s';  system '$(MAKE) clean' if -f '$(FIRST_MAKEFILE)';
 534 CODE
 535
 536         $clean .= "\t$subclean\n";
 537     }
 538
 539     return $clean;
 540 }
 541
 542
 543 =head3 dir_target
 544
 545     my $make_frag = $mm->dir_target(@directories);
 546
 547 Generates targets to create the specified directories and set its
 548 permission to 0755.
 549
 550 Because depending on a directory to just ensure it exists doesn't work
 551 too well (the modified time changes too often) dir_target() creates a
 552 .exists file in the created directory.  It is this you should depend on.
 553 For portability purposes you should use the $(DIRFILESEP) macro rather
 554 than a '/' to seperate the directory from the file.
 555
 556     yourdirectory$(DIRFILESEP).exists
 557
 558 =cut
 559
 560 sub dir_target {
 561     my($self, @dirs) = @_;
 562
 563     my $make = '';
 564     foreach my $dir (@dirs) {
 565         $make .= sprintf <<'MAKE', ($dir) x 7;
 566 %s$(DFSEP).exists :: Makefile.PL
 567         $(NOECHO) $(MKPATH) %s
 568         $(NOECHO) $(CHMOD) 755 %s
 569         $(NOECHO) $(TOUCH) %s$(DFSEP).exists
 570
 571 MAKE
 572
 573     }
 574
 575     return $make;
 576 }
 577
 578
 579 =head3 distdir
 580
 581 Defines the scratch directory target that will hold the distribution
 582 before tar-ing (or shar-ing).
 583
 584 =cut
 585
 586 # For backwards compatibility.
 587 *dist_dir = *distdir;
 588
 589 sub distdir {
 590     my($self) = shift;
 591
 592     my $meta_target = $self->{NO_META} ? '' : 'distmeta';
 593     my $sign_target = !$self->{SIGN}   ? '' : 'distsignature';
 594
 595     return sprintf <<'MAKE_FRAG', $meta_target, $sign_target;
 596 create_distdir :
 597         $(RM_RF) $(DISTVNAME)
 598         $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
 599                 -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
 600
 601 distdir : create_distdir %s %s
 602         $(NOECHO) $(NOOP)
 603
 604 MAKE_FRAG
 605
 606 }
 607
 608
 609 =head3 dist_test
 610
 611 Defines a target that produces the distribution in the
 612 scratchdirectory, and runs 'perl Makefile.PL; make ;make test' in that
 613 subdirectory.
 614
 615 =cut
 616
 617 sub dist_test {
 618     my($self) = shift;
 619
 620     my $mpl_args = join " ", map qq["$_"], @ARGV;
 621
 622     my $test = $self->cd('$(DISTVNAME)',
 623                          '$(ABSPERLRUN) Makefile.PL '.$mpl_args,
 624                          '$(MAKE) $(PASTHRU)',
 625                          '$(MAKE) test $(PASTHRU)'
 626                         );
 627
 628     return sprintf <<'MAKE_FRAG', $test;
 629 disttest : distdir
 630         %s
 631
 632 MAKE_FRAG
 633
 634
 635 }
 636
 637
 638 =head3 dynamic (o)
 639
 640 Defines the dynamic target.
 641
 642 =cut
 643
 644 sub dynamic {
 645 # --- Dynamic Loading Sections ---
 646
 647     my($self) = shift;
 648     '
 649 dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
 650         $(NOECHO) $(NOOP)
 651 ';
 652 }
 653
 654
 655 =head3 makemakerdflt_target
 656
 657   my $make_frag = $mm->makemakerdflt_target
 658
 659 Returns a make fragment with the makemakerdeflt_target specified.
 660 This target is the first target in the Makefile, is the default target
 661 and simply points off to 'all' just in case any make variant gets
 662 confused or something gets snuck in before the real 'all' target.
 663
 664 =cut
 665
 666 sub makemakerdflt_target {
 667     return <<'MAKE_FRAG';
 668 makemakerdflt : all
 669         $(NOECHO) $(NOOP)
 670 MAKE_FRAG
 671
 672 }
 673
 674
 675 =head3 manifypods_target
 676
 677   my $manifypods_target = $self->manifypods_target;
 678
 679 Generates the manifypods target.  This target generates man pages from
 680 all POD files in MAN1PODS and MAN3PODS.
 681
 682 =cut
 683
 684 sub manifypods_target {
 685     my($self) = shift;
 686
 687     my $man1pods      = '';
 688     my $man3pods      = '';
 689     my $dependencies  = '';
 690
 691     # populate manXpods & dependencies:
 692     foreach my $name (keys %{$self->{MAN1PODS}}, keys %{$self->{MAN3PODS}}) {
 693         $dependencies .= " \\\n\t$name";
 694     }
 695
 696     my $manify = <<END;
 697 manifypods : pure_all $dependencies
 698 END
 699
 700     my @man_cmds;
 701     foreach my $section (qw(1 3)) {
 702         my $pods = $self->{"MAN${section}PODS"};
 703         push @man_cmds, $self->split_command(<<CMD, %$pods);
 704         \$(NOECHO) \$(POD2MAN) --section=$section --perm_rw=\$(PERM_RW)
 705 CMD
 706     }
 707
 708     $manify .= "\t\$(NOECHO) \$(NOOP)\n" unless @man_cmds;
 709     $manify .= join '', map { "$_\n" } @man_cmds;
 710
 711     return $manify;
 712 }
 713
 714
 715 =head3 metafile_target
 716
 717     my $target = $mm->metafile_target;
 718
 719 Generate the metafile target.
 720
 721 Writes the file META.yml YAML encoded meta-data about the module in
 722 the distdir.  The format follows Module::Build's as closely as
 723 possible.
 724
 725 =cut
 726
 727 sub metafile_target {
 728     my $self = shift;
 729
 730     return <<'MAKE_FRAG' if $self->{NO_META};
 731 metafile :
 732         $(NOECHO) $(NOOP)
 733 MAKE_FRAG
 734
 735     my @metadata   = $self->metafile_data(
 736         $self->{META_ADD}   || {},
 737         $self->{META_MERGE} || {},
 738     );
 739     my $meta       = $self->metafile_file(@metadata);
 740     my @write_meta = $self->echo($meta, 'META_new.yml');
 741
 742     return sprintf <<'MAKE_FRAG', join("\n\t", @write_meta);
 743 metafile : create_distdir
 744         $(NOECHO) $(ECHO) Generating META.yml
 745         %s
 746         -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
 747 MAKE_FRAG
 748
 749 }
 750
 751
 752 =begin private
 753
 754 =head3 _sort_pairs
 755
 756     my @pairs = _sort_pairs($sort_sub, \%hash);
 757
 758 Sorts the pairs of a hash based on keys ordered according
 759 to C<$sort_sub>.
 760
 761 =end private
 762
 763 =cut
 764
 765 sub _sort_pairs {
 766     my $sort  = shift;
 767     my $pairs = shift;
 768     return map  { $_ => $pairs->{$_} }
 769            sort $sort
 770            keys %$pairs;
 771 }
 772
 773
 774 # Taken from Module::Build::Base
 775 sub _hash_merge {
 776     my ($self, $h, $k, $v) = @_;
 777     if (ref $h->{$k} eq 'ARRAY') {
 778         push @{$h->{$k}}, ref $v ? @$v : $v;
 779     } elsif (ref $h->{$k} eq 'HASH') {
 780         $self->_hash_merge($h->{$k}, $_, $v->{$_}) foreach keys %$v;
 781     } else {
 782         $h->{$k} = $v;
 783     }
 784 }
 785
 786
 787 =head3 metafile_data
 788
 789     my @metadata_pairs = $mm->metafile_data(\%meta_add, \%meta_merge);
 790
 791 Returns the data which MakeMaker turns into the META.yml file.
 792
 793 Values of %meta_add will overwrite any existing metadata in those
 794 keys.  %meta_merge will be merged with them.
 795
 796 =cut
 797
 798 sub metafile_data {
 799     my $self = shift;
 800     my($meta_add, $meta_merge) = @_;
 801
 802     # The order in which standard meta keys should be written.
 803     my @meta_order = qw(
 804         name
 805         version
 806         abstract
 807         author
 808         license
 809         distribution_type
 810
 811         configure_requires
 812         build_requires
 813         requires
 814
 815         resources
 816
 817         provides
 818         no_index
 819
 820         generated_by
 821         meta-spec
 822     );
 823
 824     my %meta = (
 825         name         => $self->{DISTNAME},
 826         version      => $self->{VERSION},
 827         abstract     => $self->{ABSTRACT},
 828         license      => $self->{LICENSE} || 'unknown',
 829         distribution_type => $self->{PM} ? 'module' : 'script',
 830
 831         configure_requires => {
 832             'ExtUtils::MakeMaker'       => 0
 833         },
 834
 835         no_index     => {
 836             directory   => [qw(t inc)]
 837         },
 838
 839         generated_by => "ExtUtils::MakeMaker version $ExtUtils::MakeMaker::VERSION",
 840         'meta-spec'  => {
 841             url         => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
 842             version     => 1.4
 843         },
 844     );
 845     $meta{author}   = defined $self->{AUTHOR}    ? [$self->{AUTHOR}] : [];
 846     $meta{requires} = $self->{PREREQ_PM} if defined $self->{PREREQ_PM};
 847
 848     while( my($key, $val) = each %$meta_add ) {
 849         $meta{$key} = $val;
 850     }
 851
 852     while( my($key, $val) = each %$meta_merge ) {
 853         $self->_hash_merge(\%meta, $key, $val);
 854     }
 855
 856     my @meta_pairs;
 857
 858     # Put the standard keys first in the proper order.
 859     for my $key (@meta_order) {
 860         next unless exists $meta{$key};
 861
 862         push @meta_pairs, $key, delete $meta{$key};
 863     }
 864
 865     # Then tack everything else onto the end, alpha sorted.
 866     for my $key (sort {lc $a cmp lc $b} keys %meta) {
 867         push @meta_pairs, $key, $meta{$key};
 868     }
 869
 870     return @meta_pairs
 871 }
 872
 873 =begin private
 874
 875 =head3 _dump_hash
 876
 877     $yaml = _dump_hash(\%options, %hash);
 878
 879 Implements a fake YAML dumper for a hash given
 880 as a list of pairs. No quoting/escaping is done. Keys
 881 are supposed to be strings. Values are undef, strings,
 882 hash refs or array refs of strings.
 883
 884 Supported options are:
 885
 886     delta => STR - indentation delta
 887     use_header => BOOL - whether to include a YAML header
 888     indent => STR - a string of spaces
 889           default: ''
 890
 891     max_key_length => INT - maximum key length used to align
 892         keys and values of the same hash
 893         default: 20
 894     key_sort => CODE - a sort sub
 895             It may be undef, which means no sorting by keys
 896         default: sub { lc $a cmp lc $b }
 897
 898     customs => HASH - special options for certain keys
 899            (whose values are hashes themselves)
 900         may contain: max_key_length, key_sort, customs
 901
 902 =end private
 903
 904 =cut
 905
 906 sub _dump_hash {
 907     croak "first argument should be a hash ref" unless ref $_[0] eq 'HASH';
 908     my $options = shift;
 909     my %hash = @_;
 910
 911     # Use a list to preserve order.
 912     my @pairs;
 913
 914     my $k_sort
 915         = exists $options->{key_sort} ? $options->{key_sort}
 916                                       : sub { lc $a cmp lc $b };
 917     if ($k_sort) {
 918         croak "'key_sort' should be a coderef" unless ref $k_sort eq 'CODE';
 919         @pairs = _sort_pairs($k_sort, \%hash);
 920     } else { # list of pairs, no sorting
 921         @pairs = @_;
 922     }
 923
 924     my $yaml     = $options->{use_header} ? "--- #YAML:1.0\n" : '';
 925     my $indent   = $options->{indent} || '';
 926     my $k_length = min(
 927         ($options->{max_key_length} || 20),
 928         max(map { length($_) + 1 } grep { !ref $hash{$_} } keys %hash)
 929     );
 930     my $customs  = $options->{customs} || {};
 931
 932     # printf format for key
 933     my $k_format = "%-${k_length}s";
 934
 935     while( @pairs ) {
 936         my($key, $val) = splice @pairs, 0, 2;
 937         $val = '~' unless defined $val;
 938         if(ref $val eq 'HASH') {
 939             if ( keys %$val ) {
 940                 my %k_options = ( # options for recursive call
 941                     delta => $options->{delta},
 942                     use_header => 0,
 943                     indent => $indent . $options->{delta},
 944                 );
 945                 if (exists $customs->{$key}) {
 946                     my %k_custom = %{$customs->{$key}};
 947                     foreach my $k qw(key_sort max_key_length customs) {
 948                         $k_options{$k} = $k_custom{$k} if exists $k_custom{$k};
 949                     }
 950                 }
 951                 $yaml .= $indent . "$key:\n"
 952                   . _dump_hash(\%k_options, %$val);
 953             }
 954             else {
 955                 $yaml .= $indent . "$key:  {}\n";
 956             }
 957         }
 958         elsif (ref $val eq 'ARRAY') {
 959             if( @$val ) {
 960                 $yaml .= $indent . "$key:\n";
 961
 962                 for (@$val) {
 963                     croak "only nested arrays of non-refs are supported" if ref $_;
 964                     $yaml .= $indent . $options->{delta} . "- $_\n";
 965                 }
 966             }
 967             else {
 968                 $yaml .= $indent . "$key:  []\n";
 969             }
 970         }
 971         elsif( ref $val and !blessed($val) ) {
 972             croak "only nested hashes, arrays and objects are supported";
 973         }
 974         else {  # if it's an object, just stringify it
 975             $yaml .= $indent . sprintf "$k_format  %s\n", "$key:", $val;
 976         }
 977     };
 978
 979     return $yaml;
 980
 981 }
 982
 983 sub blessed {
 984     return eval { $_[0]->isa("UNIVERSAL"); };
 985 }
 986
 987 sub max {
 988     return (sort { $b <=> $a } @_)[0];
 989 }
 990
 991 sub min {
 992     return (sort { $a <=> $b } @_)[0];
 993 }
 994
 995 =head3 metafile_file
 996
 997     my $meta_yml = $mm->metafile_file(@metadata_pairs);
 998
 999 Turns the @metadata_pairs into YAML.
1000
1001 This method does not implement a complete YAML dumper, being limited
1002 to dump a hash with values which are strings, undef's or nested hashes
1003 and arrays of strings. No quoting/escaping is done.
1004
1005 =cut
1006
1007 sub metafile_file {
1008     my $self = shift;
1009
1010     my %dump_options = (
1011         use_header => 1,
1012         delta      => ' ' x 4,
1013         key_sort   => undef,
1014     );
1015     return _dump_hash(\%dump_options, @_);
1016
1017 }
1018
1019
1020 =head3 distmeta_target
1021
1022     my $make_frag = $mm->distmeta_target;
1023
1024 Generates the distmeta target to add META.yml to the MANIFEST in the
1025 distdir.
1026
1027 =cut
1028
1029 sub distmeta_target {
1030     my $self = shift;
1031
1032     my $add_meta = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']);
1033 eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) }
1034     or print "Could not add META.yml to MANIFEST: $${'@'}\n"
1035 CODE
1036
1037     my $add_meta_to_distdir = $self->cd('$(DISTVNAME)', $add_meta);
1038
1039     return sprintf <<'MAKE', $add_meta_to_distdir;
1040 distmeta : create_distdir metafile
1041         $(NOECHO) %s
1042
1043 MAKE
1044
1045 }
1046
1047
1048 =head3 realclean (o)
1049
1050 Defines the realclean target.
1051
1052 =cut
1053
1054 sub realclean {
1055     my($self, %attribs) = @_;
1056
1057     my @dirs  = qw($(DISTVNAME));
1058     my @files = qw($(FIRST_MAKEFILE) $(MAKEFILE_OLD));
1059
1060     # Special exception for the perl core where INST_* is not in blib.
1061     # This cleans up the files built from the ext/ directory (all XS).
1062     if( $self->{PERL_CORE} ) {
1063         push @dirs, qw($(INST_AUTODIR) $(INST_ARCHAUTODIR));
1064         push @files, values %{$self->{PM}};
1065     }
1066
1067     if( $self->has_link_code ){
1068         push @files, qw($(OBJECT));
1069     }
1070
1071     if( $attribs{FILES} ) {
1072         if( ref $attribs{FILES} ) {
1073             push @dirs, @{ $attribs{FILES} };
1074         }
1075         else {
1076             push @dirs, split /\s+/, $attribs{FILES};
1077         }
1078     }
1079
1080     # Occasionally files are repeated several times from different sources
1081     { my(%f) = map { ($_ => 1) } @files;  @files = keys %f; }
1082     { my(%d) = map { ($_ => 1) } @dirs;   @dirs  = keys %d; }
1083
1084     my $rm_cmd  = join "\n\t", map { "$_" }
1085                     $self->split_command('- $(RM_F)',  @files);
1086     my $rmf_cmd = join "\n\t", map { "$_" }
1087                     $self->split_command('- $(RM_RF)', @dirs);
1088
1089     my $m = sprintf <<'MAKE', $rm_cmd, $rmf_cmd;
1090 # Delete temporary files (via clean) and also delete dist files
1091 realclean purge ::  clean realclean_subdirs
1092         %s
1093         %s
1094 MAKE
1095
1096     $m .= "\t$attribs{POSTOP}\n" if $attribs{POSTOP};
1097
1098     return $m;
1099 }
1100
1101
1102 =head3 realclean_subdirs_target
1103
1104   my $make_frag = $MM->realclean_subdirs_target;
1105
1106 Returns the realclean_subdirs target.  This is used by the realclean
1107 target to call realclean on any subdirectories which contain Makefiles.
1108
1109 =cut
1110
1111 sub realclean_subdirs_target {
1112     my $self = shift;
1113
1114     return <<'NOOP_FRAG' unless @{$self->{DIR}};
1115 realclean_subdirs :
1116         $(NOECHO) $(NOOP)
1117 NOOP_FRAG
1118
1119     my $rclean = "realclean_subdirs :\n";
1120
1121     foreach my $dir (@{$self->{DIR}}) {
1122         foreach my $makefile ('$(MAKEFILE_OLD)', '$(FIRST_MAKEFILE)' ) {
1123             my $subrclean .= $self->oneliner(sprintf <<'CODE', $dir, ($makefile) x 2);
1124 chdir '%s';  system '$(MAKE) $(USEMAKEFILE) %s realclean' if -f '%s';
1125 CODE
1126
1127             $rclean .= sprintf <<'RCLEAN', $subrclean;
1128         - %s
1129 RCLEAN
1130
1131         }
1132     }
1133
1134     return $rclean;
1135 }
1136
1137
1138 =head3 signature_target
1139
1140     my $target = $mm->signature_target;
1141
1142 Generate the signature target.
1143
1144 Writes the file SIGNATURE with "cpansign -s".
1145
1146 =cut
1147
1148 sub signature_target {
1149     my $self = shift;
1150
1151     return <<'MAKE_FRAG';
1152 signature :
1153         cpansign -s
1154 MAKE_FRAG
1155
1156 }
1157
1158
1159 =head3 distsignature_target
1160
1161     my $make_frag = $mm->distsignature_target;
1162
1163 Generates the distsignature target to add SIGNATURE to the MANIFEST in the
1164 distdir.
1165
1166 =cut
1167
1168 sub distsignature_target {
1169     my $self = shift;
1170
1171     my $add_sign = $self->oneliner(<<'CODE', ['-MExtUtils::Manifest=maniadd']);
1172 eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) }
1173     or print "Could not add SIGNATURE to MANIFEST: $${'@'}\n"
1174 CODE
1175
1176     my $sign_dist        = $self->cd('$(DISTVNAME)' => 'cpansign -s');
1177
1178     # cpansign -s complains if SIGNATURE is in the MANIFEST yet does not
1179     # exist
1180     my $touch_sig        = $self->cd('$(DISTVNAME)' => '$(TOUCH) SIGNATURE');
1181     my $add_sign_to_dist = $self->cd('$(DISTVNAME)' => $add_sign );
1182
1183     return sprintf <<'MAKE', $add_sign_to_dist, $touch_sig, $sign_dist
1184 distsignature : create_distdir
1185         $(NOECHO) %s
1186         $(NOECHO) %s
1187         %s
1188
1189 MAKE
1190
1191 }
1192
1193
1194 =head3 special_targets
1195
1196   my $make_frag = $mm->special_targets
1197
1198 Returns a make fragment containing any targets which have special
1199 meaning to make.  For example, .SUFFIXES and .PHONY.
1200
1201 =cut
1202
1203 sub special_targets {
1204     my $make_frag = <<'MAKE_FRAG';
1205 .SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
1206
1207 .PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
1208
1209 MAKE_FRAG
1210
1211     $make_frag .= <<'MAKE_FRAG' if $ENV{CLEARCASE_ROOT};
1212 .NO_CONFIG_REC: Makefile
1213
1214 MAKE_FRAG
1215
1216     return $make_frag;
1217 }
1218
1219
1220
1221
1222 =head2 Init methods
1223
1224 Methods which help initialize the MakeMaker object and macros.
1225
1226
1227 =head3 init_ABSTRACT
1228
1229     $mm->init_ABSTRACT
1230
1231 =cut
1232
1233 sub init_ABSTRACT {
1234     my $self = shift;
1235
1236     if( $self->{ABSTRACT_FROM} and $self->{ABSTRACT} ) {
1237         warn "Both ABSTRACT_FROM and ABSTRACT are set.  ".
1238              "Ignoring ABSTRACT_FROM.\n";
1239         return;
1240     }
1241
1242     if ($self->{ABSTRACT_FROM}){
1243         $self->{ABSTRACT} = $self->parse_abstract($self->{ABSTRACT_FROM}) or
1244             carp "WARNING: Setting ABSTRACT via file ".
1245                  "'$self->{ABSTRACT_FROM}' failed\n";
1246     }
1247 }
1248
1249 =head3 init_INST
1250
1251     $mm->init_INST;
1252
1253 Called by init_main.  Sets up all INST_* variables except those related
1254 to XS code.  Those are handled in init_xs.
1255
1256 =cut
1257
1258 sub init_INST {
1259     my($self) = shift;
1260
1261     $self->{INST_ARCHLIB} ||= $self->catdir($Curdir,"blib","arch");
1262     $self->{INST_BIN}     ||= $self->catdir($Curdir,'blib','bin');
1263
1264     # INST_LIB typically pre-set if building an extension after
1265     # perl has been built and installed. Setting INST_LIB allows
1266     # you to build directly into, say $Config{privlibexp}.
1267     unless ($self->{INST_LIB}){
1268         if ($self->{PERL_CORE}) {
1269             if (defined $Cross::platform) {
1270                 $self->{INST_LIB} = $self->{INST_ARCHLIB} =
1271                   $self->catdir($self->{PERL_LIB},"..","xlib",
1272                                      $Cross::platform);
1273             }
1274             else {
1275                 $self->{INST_LIB} = $self->{INST_ARCHLIB} = $self->{PERL_LIB};
1276             }
1277         } else {
1278             $self->{INST_LIB} = $self->catdir($Curdir,"blib","lib");
1279         }
1280     }
1281
1282     my @parentdir = split(/::/, $self->{PARENT_NAME});
1283     $self->{INST_LIBDIR}      = $self->catdir('$(INST_LIB)',     @parentdir);
1284     $self->{INST_ARCHLIBDIR}  = $self->catdir('$(INST_ARCHLIB)', @parentdir);
1285     $self->{INST_AUTODIR}     = $self->catdir('$(INST_LIB)', 'auto',
1286                                               '$(FULLEXT)');
1287     $self->{INST_ARCHAUTODIR} = $self->catdir('$(INST_ARCHLIB)', 'auto',
1288                                               '$(FULLEXT)');
1289
1290     $self->{INST_SCRIPT}  ||= $self->catdir($Curdir,'blib','script');
1291
1292     $self->{INST_MAN1DIR} ||= $self->catdir($Curdir,'blib','man1');
1293     $self->{INST_MAN3DIR} ||= $self->catdir($Curdir,'blib','man3');
1294
1295     return 1;
1296 }
1297
1298
1299 =head3 init_INSTALL
1300
1301     $mm->init_INSTALL;
1302
1303 Called by init_main.  Sets up all INSTALL_* variables (except
1304 INSTALLDIRS) and *PREFIX.
1305
1306 =cut
1307
1308 sub init_INSTALL {
1309     my($self) = shift;
1310
1311     if( $self->{ARGS}{INSTALL_BASE} and $self->{ARGS}{PREFIX} ) {
1312         die "Only one of PREFIX or INSTALL_BASE can be given.  Not both.\n";
1313     }
1314
1315     if( $self->{ARGS}{INSTALL_BASE} ) {
1316         $self->init_INSTALL_from_INSTALL_BASE;
1317     }
1318     else {
1319         $self->init_INSTALL_from_PREFIX;
1320     }
1321 }
1322
1323
1324 =head3 init_INSTALL_from_PREFIX
1325
1326   $mm->init_INSTALL_from_PREFIX;
1327
1328 =cut
1329
1330 sub init_INSTALL_from_PREFIX {
1331     my $self = shift;
1332
1333     $self->init_lib2arch;
1334
1335     # There are often no Config.pm defaults for these new man variables so
1336     # we fall back to the old behavior which is to use installman*dir
1337     foreach my $num (1, 3) {
1338         my $k = 'installsiteman'.$num.'dir';
1339
1340         $self->{uc $k} ||= uc "\$(installman${num}dir)"
1341           unless $Config{$k};
1342     }
1343
1344     foreach my $num (1, 3) {
1345         my $k = 'installvendorman'.$num.'dir';
1346
1347         unless( $Config{$k} ) {
1348             $self->{uc $k}  ||= $Config{usevendorprefix}
1349                               ? uc "\$(installman${num}dir)"
1350                               : '';
1351         }
1352     }
1353
1354     $self->{INSTALLSITEBIN} ||= '$(INSTALLBIN)'
1355       unless $Config{installsitebin};
1356     $self->{INSTALLSITESCRIPT} ||= '$(INSTALLSCRIPT)'
1357       unless $Config{installsitescript};
1358
1359     unless( $Config{installvendorbin} ) {
1360         $self->{INSTALLVENDORBIN} ||= $Config{usevendorprefix}
1361                                     ? $Config{installbin}
1362                                     : '';
1363     }
1364     unless( $Config{installvendorscript} ) {
1365         $self->{INSTALLVENDORSCRIPT} ||= $Config{usevendorprefix}
1366                                        ? $Config{installscript}
1367                                        : '';
1368     }
1369
1370
1371     my $iprefix = $Config{installprefixexp} || $Config{installprefix} ||
1372                   $Config{prefixexp}        || $Config{prefix} || '';
1373     my $vprefix = $Config{usevendorprefix}  ? $Config{vendorprefixexp} : '';
1374     my $sprefix = $Config{siteprefixexp}    || '';
1375
1376     # 5.005_03 doesn't have a siteprefix.
1377     $sprefix = $iprefix unless $sprefix;
1378
1379
1380     $self->{PREFIX}       ||= '';
1381
1382     if( $self->{PREFIX} ) {
1383         @{$self}{qw(PERLPREFIX SITEPREFIX VENDORPREFIX)} =
1384           ('$(PREFIX)') x 3;
1385     }
1386     else {
1387         $self->{PERLPREFIX}   ||= $iprefix;
1388         $self->{SITEPREFIX}   ||= $sprefix;
1389         $self->{VENDORPREFIX} ||= $vprefix;
1390
1391         # Lots of MM extension authors like to use $(PREFIX) so we
1392         # put something sensible in there no matter what.
1393         $self->{PREFIX} = '$('.uc $self->{INSTALLDIRS}.'PREFIX)';
1394     }
1395
1396     my $arch    = $Config{archname};
1397     my $version = $Config{version};
1398
1399     # default style
1400     my $libstyle = $Config{installstyle} || 'lib/perl5';
1401     my $manstyle = '';
1402
1403     if( $self->{LIBSTYLE} ) {
1404         $libstyle = $self->{LIBSTYLE};
1405         $manstyle = $self->{LIBSTYLE} eq 'lib/perl5' ? 'lib/perl5' : '';
1406     }
1407
1408     # Some systems, like VOS, set installman*dir to '' if they can't
1409     # read man pages.
1410     for my $num (1, 3) {
1411         $self->{'INSTALLMAN'.$num.'DIR'} ||= 'none'
1412           unless $Config{'installman'.$num.'dir'};
1413     }
1414
1415     my %bin_layouts =
1416     (
1417         bin         => { s => $iprefix,
1418                          t => 'perl',
1419                          d => 'bin' },
1420         vendorbin   => { s => $vprefix,
1421                          t => 'vendor',
1422                          d => 'bin' },
1423         sitebin     => { s => $sprefix,
1424                          t => 'site',
1425                          d => 'bin' },
1426         script      => { s => $iprefix,
1427                          t => 'perl',
1428                          d => 'bin' },
1429         vendorscript=> { s => $vprefix,
1430                          t => 'vendor',
1431                          d => 'bin' },
1432         sitescript  => { s => $sprefix,
1433                          t => 'site',
1434                          d => 'bin' },
1435     );
1436
1437     my %man_layouts =
1438     (
1439         man1dir         => { s => $iprefix,
1440                              t => 'perl',
1441                              d => 'man/man1',
1442                              style => $manstyle, },
1443         siteman1dir     => { s => $sprefix,
1444                              t => 'site',
1445                              d => 'man/man1',
1446                              style => $manstyle, },
1447         vendorman1dir   => { s => $vprefix,
1448                              t => 'vendor',
1449                              d => 'man/man1',
1450                              style => $manstyle, },
1451
1452         man3dir         => { s => $iprefix,
1453                              t => 'perl',
1454                              d => 'man/man3',
1455                              style => $manstyle, },
1456         siteman3dir     => { s => $sprefix,
1457                              t => 'site',
1458                              d => 'man/man3',
1459                              style => $manstyle, },
1460         vendorman3dir   => { s => $vprefix,
1461                              t => 'vendor',
1462                              d => 'man/man3',
1463                              style => $manstyle, },
1464     );
1465
1466     my %lib_layouts =
1467     (
1468         privlib     => { s => $iprefix,
1469                          t => 'perl',
1470                          d => '',
1471                          style => $libstyle, },
1472         vendorlib   => { s => $vprefix,
1473                          t => 'vendor',
1474                          d => '',
1475                          style => $libstyle, },
1476         sitelib     => { s => $sprefix,
1477                          t => 'site',
1478                          d => 'site_perl',
1479                          style => $libstyle, },
1480
1481         archlib     => { s => $iprefix,
1482                          t => 'perl',
1483                          d => "$version/$arch",
1484                          style => $libstyle },
1485         vendorarch  => { s => $vprefix,
1486                          t => 'vendor',
1487                          d => "$version/$arch",
1488                          style => $libstyle },
1489         sitearch    => { s => $sprefix,
1490                          t => 'site',
1491                          d => "site_perl/$version/$arch",
1492                          style => $libstyle },
1493     );
1494
1495
1496     # Special case for LIB.
1497     if( $self->{LIB} ) {
1498         foreach my $var (keys %lib_layouts) {
1499             my $Installvar = uc "install$var";
1500
1501             if( $var =~ /arch/ ) {
1502                 $self->{$Installvar} ||=
1503                   $self->catdir($self->{LIB}, $Config{archname});
1504             }
1505             else {
1506                 $self->{$Installvar} ||= $self->{LIB};
1507             }
1508         }
1509     }
1510
1511     my %type2prefix = ( perl    => 'PERLPREFIX',
1512                         site    => 'SITEPREFIX',
1513                         vendor  => 'VENDORPREFIX'
1514                       );
1515
1516     my %layouts = (%bin_layouts, %man_layouts, %lib_layouts);
1517     while( my($var, $layout) = each(%layouts) ) {
1518         my($s, $t, $d, $style) = @{$layout}{qw(s t d style)};
1519         my $r = '$('.$type2prefix{$t}.')';
1520
1521         print STDERR "Prefixing $var\n" if $Verbose >= 2;
1522
1523         my $installvar = "install$var";
1524         my $Installvar = uc $installvar;
1525         next if $self->{$Installvar};
1526
1527         $d = "$style/$d" if $style;
1528         $self->prefixify($installvar, $s, $r, $d);
1529
1530         print STDERR "  $Installvar == $self->{$Installvar}\n"
1531           if $Verbose >= 2;
1532     }
1533
1534     # Generate these if they weren't figured out.
1535     $self->{VENDORARCHEXP} ||= $self->{INSTALLVENDORARCH};
1536     $self->{VENDORLIBEXP}  ||= $self->{INSTALLVENDORLIB};
1537
1538     return 1;
1539 }
1540
1541
1542 =head3 init_from_INSTALL_BASE
1543
1544     $mm->init_from_INSTALL_BASE
1545
1546 =cut
1547
1548 my %map = (
1549            lib      => [qw(lib perl5)],
1550            arch     => [('lib', 'perl5', $Config{archname})],
1551            bin      => [qw(bin)],
1552            man1dir  => [qw(man man1)],
1553            man3dir  => [qw(man man3)]
1554           );
1555 $map{script} = $map{bin};
1556
1557 sub init_INSTALL_from_INSTALL_BASE {
1558     my $self = shift;
1559
1560     @{$self}{qw(PREFIX VENDORPREFIX SITEPREFIX PERLPREFIX)} =
1561                                                          '$(INSTALL_BASE)';
1562
1563     my %install;
1564     foreach my $thing (keys %map) {
1565         foreach my $dir (('', 'SITE', 'VENDOR')) {
1566             my $uc_thing = uc $thing;
1567             my $key = "INSTALL".$dir.$uc_thing;
1568
1569             $install{$key} ||=
1570               $self->catdir('$(INSTALL_BASE)', @{$map{$thing}});
1571         }
1572     }
1573
1574     # Adjust for variable quirks.
1575     $install{INSTALLARCHLIB} ||= delete $install{INSTALLARCH};
1576     $install{INSTALLPRIVLIB} ||= delete $install{INSTALLLIB};
1577
1578     foreach my $key (keys %install) {
1579         $self->{$key} ||= $install{$key};
1580     }
1581
1582     return 1;
1583 }
1584
1585
1586 =head3 init_VERSION  I<Abstract>
1587
1588     $mm->init_VERSION
1589
1590 Initialize macros representing versions of MakeMaker and other tools
1591
1592 MAKEMAKER: path to the MakeMaker module.
1593
1594 MM_VERSION: ExtUtils::MakeMaker Version
1595
1596 MM_REVISION: ExtUtils::MakeMaker version control revision (for backwards
1597              compat)
1598
1599 VERSION: version of your module
1600
1601 VERSION_MACRO: which macro represents the version (usually 'VERSION')
1602
1603 VERSION_SYM: like version but safe for use as an RCS revision number
1604
1605 DEFINE_VERSION: -D line to set the module version when compiling
1606
1607 XS_VERSION: version in your .xs file.  Defaults to $(VERSION)
1608
1609 XS_VERSION_MACRO: which macro represents the XS version.
1610
1611 XS_DEFINE_VERSION: -D line to set the xs version when compiling.
1612
1613 Called by init_main.
1614
1615 =cut
1616
1617 sub init_VERSION {
1618     my($self) = shift;
1619
1620     $self->{MAKEMAKER}  = $ExtUtils::MakeMaker::Filename;
1621     $self->{MM_VERSION} = $ExtUtils::MakeMaker::VERSION;
1622     $self->{MM_REVISION}= $ExtUtils::MakeMaker::Revision;
1623     $self->{VERSION_FROM} ||= '';
1624
1625     if ($self->{VERSION_FROM}){
1626         $self->{VERSION} = $self->parse_version($self->{VERSION_FROM});
1627         if( $self->{VERSION} eq 'undef' ) {
1628             carp("WARNING: Setting VERSION via file ".
1629                  "'$self->{VERSION_FROM}' failed\n");
1630         }
1631     }
1632
1633     # strip blanks
1634     if (defined $self->{VERSION}) {
1635         $self->{VERSION} =~ s/^\s+//;
1636         $self->{VERSION} =~ s/\s+$//;
1637     }
1638     else {
1639         $self->{VERSION} = '';
1640     }
1641
1642
1643     $self->{VERSION_MACRO}  = 'VERSION';
1644     ($self->{VERSION_SYM} = $self->{VERSION}) =~ s/\W/_/g;
1645     $self->{DEFINE_VERSION} = '-D$(VERSION_MACRO)=\"$(VERSION)\"';
1646
1647
1648     # Graham Barr and Paul Marquess had some ideas how to ensure
1649     # version compatibility between the *.pm file and the
1650     # corresponding *.xs file. The bottomline was, that we need an
1651     # XS_VERSION macro that defaults to VERSION:
1652     $self->{XS_VERSION} ||= $self->{VERSION};
1653
1654     $self->{XS_VERSION_MACRO}  = 'XS_VERSION';
1655     $self->{XS_DEFINE_VERSION} = '-D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"';
1656
1657 }
1658
1659
1660 =head3 init_others  I<Abstract>
1661
1662     $MM->init_others();
1663
1664 Initializes the macro definitions used by tools_other() and places them
1665 in the $MM object.
1666
1667 If there is no description, its the same as the parameter to
1668 WriteMakefile() documented in ExtUtils::MakeMaker.
1669
1670 Defines at least these macros.
1671
1672   Macro             Description
1673
1674   NOOP              Do nothing
1675   NOECHO            Tell make not to display the command itself
1676
1677   MAKEFILE
1678   FIRST_MAKEFILE
1679   MAKEFILE_OLD
1680   MAKE_APERL_FILE   File used by MAKE_APERL
1681
1682   SHELL             Program used to run shell commands
1683
1684   ECHO              Print text adding a newline on the end
1685   RM_F              Remove a file
1686   RM_RF             Remove a directory
1687   TOUCH             Update a file's timestamp
1688   TEST_F            Test for a file's existence
1689   CP                Copy a file
1690   MV                Move a file
1691   CHMOD             Change permissions on a
1692                     file
1693
1694   UMASK_NULL        Nullify umask
1695   DEV_NULL          Suppress all command output
1696
1697
1698 =head3 init_DIRFILESEP  I<Abstract>
1699
1700   $MM->init_DIRFILESEP;
1701   my $dirfilesep = $MM->{DIRFILESEP};
1702
1703 Initializes the DIRFILESEP macro which is the seperator between the
1704 directory and filename in a filepath.  ie. / on Unix, \ on Win32 and
1705 nothing on VMS.
1706
1707 For example:
1708
1709     # instead of $(INST_ARCHAUTODIR)/extralibs.ld
1710     $(INST_ARCHAUTODIR)$(DIRFILESEP)extralibs.ld
1711
1712 Something of a hack but it prevents a lot of code duplication between
1713 MM_* variants.
1714
1715 Do not use this as a seperator between directories.  Some operating
1716 systems use different seperators between subdirectories as between
1717 directories and filenames (for example:  VOLUME:[dir1.dir2]file on VMS).
1718
1719 =head3 init_linker  I<Abstract>
1720
1721     $mm->init_linker;
1722
1723 Initialize macros which have to do with linking.
1724
1725 PERL_ARCHIVE: path to libperl.a equivalent to be linked to dynamic
1726 extensions.
1727
1728 PERL_ARCHIVE_AFTER: path to a library which should be put on the
1729 linker command line I<after> the external libraries to be linked to
1730 dynamic extensions.  This may be needed if the linker is one-pass, and
1731 Perl includes some overrides for C RTL functions, such as malloc().
1732
1733 EXPORT_LIST: name of a file that is passed to linker to define symbols
1734 to be exported.
1735
1736 Some OSes do not need these in which case leave it blank.
1737
1738
1739 =head3 init_platform
1740
1741     $mm->init_platform
1742
1743 Initialize any macros which are for platform specific use only.
1744
1745 A typical one is the version number of your OS specific mocule.
1746 (ie. MM_Unix_VERSION or MM_VMS_VERSION).
1747
1748 =cut
1749
1750 sub init_platform {
1751     return '';
1752 }
1753
1754
1755 =head3 init_MAKE
1756
1757     $mm->init_MAKE
1758
1759 Initialize MAKE from either a MAKE environment variable or $Config{make}.
1760
1761 =cut
1762
1763 sub init_MAKE {
1764     my $self = shift;
1765
1766     $self->{MAKE} ||= $ENV{MAKE} || $Config{make};
1767 }
1768
1769
1770 =head2 Tools
1771
1772 A grab bag of methods to generate specific macros and commands.
1773
1774
1775
1776 =head3 manifypods
1777
1778 Defines targets and routines to translate the pods into manpages and
1779 put them into the INST_* directories.
1780
1781 =cut
1782
1783 sub manifypods {
1784     my $self          = shift;
1785
1786     my $POD2MAN_macro = $self->POD2MAN_macro();
1787     my $manifypods_target = $self->manifypods_target();
1788
1789     return <<END_OF_TARGET;
1790
1791 $POD2MAN_macro
1792
1793 $manifypods_target
1794
1795 END_OF_TARGET
1796
1797 }
1798
1799
1800 =head3 POD2MAN_macro
1801
1802   my $pod2man_macro = $self->POD2MAN_macro
1803
1804 Returns a definition for the POD2MAN macro.  This is a program
1805 which emulates the pod2man utility.  You can add more switches to the
1806 command by simply appending them on the macro.
1807
1808 Typical usage:
1809
1810     $(POD2MAN) --section=3 --perm_rw=$(PERM_RW) podfile1 man_page1 ...
1811
1812 =cut
1813
1814 sub POD2MAN_macro {
1815     my $self = shift;
1816
1817 # Need the trailing '--' so perl stops gobbling arguments and - happens
1818 # to be an alternative end of line seperator on VMS so we quote it
1819     return <<'END_OF_DEF';
1820 POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
1821 POD2MAN = $(POD2MAN_EXE)
1822 END_OF_DEF
1823 }
1824
1825
1826 =head3 test_via_harness
1827
1828   my $command = $mm->test_via_harness($perl, $tests);
1829
1830 Returns a $command line which runs the given set of $tests with
1831 Test::Harness and the given $perl.
1832
1833 Used on the t/*.t files.
1834
1835 =cut
1836
1837 sub test_via_harness {
1838     my($self, $perl, $tests) = @_;
1839
1840     return qq{\t$perl "-MExtUtils::Command::MM" }.
1841            qq{"-e" "test_harness(\$(TEST_VERBOSE), '\$(INST_LIB)', '\$(INST_ARCHLIB)')" $tests\n};
1842 }
1843
1844 =head3 test_via_script
1845
1846   my $command = $mm->test_via_script($perl, $script);
1847
1848 Returns a $command line which just runs a single test without
1849 Test::Harness.  No checks are done on the results, they're just
1850 printed.
1851
1852 Used for test.pl, since they don't always follow Test::Harness
1853 formatting.
1854
1855 =cut
1856
1857 sub test_via_script {
1858     my($self, $perl, $script) = @_;
1859     return qq{\t$perl "-I\$(INST_LIB)" "-I\$(INST_ARCHLIB)" $script\n};
1860 }
1861
1862
1863 =head3 tool_autosplit
1864
1865 Defines a simple perl call that runs autosplit. May be deprecated by
1866 pm_to_blib soon.
1867
1868 =cut
1869
1870 sub tool_autosplit {
1871     my($self, %attribs) = @_;
1872
1873     my $maxlen = $attribs{MAXLEN} ? '$$AutoSplit::Maxlen=$attribs{MAXLEN};'
1874                                   : '';
1875
1876     my $asplit = $self->oneliner(sprintf <<'PERL_CODE', $maxlen);
1877 use AutoSplit; %s autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)
1878 PERL_CODE
1879
1880     return sprintf <<'MAKE_FRAG', $asplit;
1881 # Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
1882 AUTOSPLITFILE = %s
1883
1884 MAKE_FRAG
1885
1886 }
1887
1888
1889
1890
1891 =head2 File::Spec wrappers
1892
1893 ExtUtils::MM_Any is a subclass of File::Spec.  The methods noted here
1894 override File::Spec.
1895
1896
1897
1898 =head3 catfile
1899
1900 File::Spec <= 0.83 has a bug where the file part of catfile is not
1901 canonicalized.  This override fixes that bug.
1902
1903 =cut
1904
1905 sub catfile {
1906     my $self = shift;
1907     return $self->canonpath($self->SUPER::catfile(@_));
1908 }
1909
1910
1911
1912 =head2 Misc
1913
1914 Methods I can't really figure out where they should go yet.
1915
1916
1917 =head3 find_tests
1918
1919   my $test = $mm->find_tests;
1920
1921 Returns a string suitable for feeding to the shell to return all
1922 tests in t/*.t.
1923
1924 =cut
1925
1926 sub find_tests {
1927     my($self) = shift;
1928     return -d 't' ? 't/*.t' : '';
1929 }
1930
1931
1932 =head3 extra_clean_files
1933
1934     my @files_to_clean = $MM->extra_clean_files;
1935
1936 Returns a list of OS specific files to be removed in the clean target in
1937 addition to the usual set.
1938
1939 =cut
1940
1941 # An empty method here tickled a perl 5.8.1 bug and would return its object.
1942 sub extra_clean_files {
1943     return;
1944 }
1945
1946
1947 =head3 installvars
1948
1949     my @installvars = $mm->installvars;
1950
1951 A list of all the INSTALL* variables without the INSTALL prefix.  Useful
1952 for iteration or building related variable sets.
1953
1954 =cut
1955
1956 sub installvars {
1957     return qw(PRIVLIB SITELIB  VENDORLIB
1958               ARCHLIB SITEARCH VENDORARCH
1959               BIN     SITEBIN  VENDORBIN
1960               SCRIPT  SITESCRIPT  VENDORSCRIPT
1961               MAN1DIR SITEMAN1DIR VENDORMAN1DIR
1962               MAN3DIR SITEMAN3DIR VENDORMAN3DIR
1963              );
1964 }
1965
1966
1967 =head3 libscan
1968
1969   my $wanted = $self->libscan($path);
1970
1971 Takes a path to a file or dir and returns an empty string if we don't
1972 want to include this file in the library.  Otherwise it returns the
1973 the $path unchanged.
1974
1975 Mainly used to exclude version control administrative directories from
1976 installation.
1977
1978 =cut
1979
1980 sub libscan {
1981     my($self,$path) = @_;
1982     my($dirs,$file) = ($self->splitpath($path))[1,2];
1983     return '' if grep /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/,
1984                      $self->splitdir($dirs), $file;
1985
1986     return $path;
1987 }
1988
1989
1990 =head3 platform_constants
1991
1992     my $make_frag = $mm->platform_constants
1993
1994 Returns a make fragment defining all the macros initialized in
1995 init_platform() rather than put them in constants().
1996
1997 =cut
1998
1999 sub platform_constants {
2000     return '';
2001 }
2002
2003
2004 =head1 AUTHOR
2005
2006 Michael G Schwern <schwern@pobox.com> and the denizens of
2007 makemaker@perl.org with code from ExtUtils::MM_Unix and
2008 ExtUtils::MM_Win32.
2009
2010
2011 =cut
2012
2013 1;