make_ext.pl

   1 #!./miniperl
   2 use strict;
   3 use warnings;
   4 use Config;
   5 use constant IS_CROSS => defined $Config::Config{usecrosscompile} ? 1 : 0;
   6
   7 my $is_Win32 = $^O eq 'MSWin32';
   8 my $is_VMS = $^O eq 'VMS';
   9 my $is_Unix = !$is_Win32 && !$is_VMS;
  10
  11 my @ext_dirs = qw(cpan dist ext);
  12 my $ext_dirs_re = '(?:' . join('|', @ext_dirs) . ')';
  13
  14 # This script acts as a simple interface for building extensions.
  15
  16 # It's actually a cut and shut of the Unix version ext/utils/makeext and the
  17 # Windows version win32/build_ext.pl hence the two invocation styles.
  18
  19 # On Unix, it primarily used by the perl Makefile one extension at a time:
  20 #
  21 # d_dummy $(dynamic_ext): miniperl preplibrary FORCE
  22 #       @$(RUN) ./miniperl make_ext.pl --target=dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
  23 #
  24 # On Windows or VMS,
  25 # If '--static' is specified, static extensions will be built.
  26 # If '--dynamic' is specified, dynamic extensions will be built.
  27 # If '--nonxs' is specified, nonxs extensions will be built.
  28 # If '--dynaloader' is specified, DynaLoader will be built.
  29 # If '--all' is specified, all extensions will be built.
  30 #
  31 #    make_ext.pl "MAKE=make [-make_opts]" --dir=directory [--target=target] [--static|--dynamic|--all] +ext2 !ext1
  32 #
  33 # E.g.
  34 #
  35 #     make_ext.pl "MAKE=nmake -nologo" --dir=..\ext
  36 #
  37 #     make_ext.pl "MAKE=nmake -nologo" --dir=..\ext --target=clean
  38 #
  39 #     make_ext.pl MAKE=dmake --dir=..\ext
  40 #
  41 #     make_ext.pl MAKE=dmake --dir=..\ext --target=clean
  42 #
  43 # Will skip building extensions which are marked with an '!' char.
  44 # Mostly because they still not ported to specified platform.
  45 #
  46 # If any extensions are listed with a '+' char then only those
  47 # extensions will be built, but only if they aren't countermanded
  48 # by an '!ext' and are appropriate to the type of building being done.
  49 # An extensions follows the format of Foo/Bar, which would be extension Foo::Bar
  50
  51 # It may be deleted in a later release of perl so try to
  52 # avoid using it for other purposes.
  53
  54 my (%excl, %incl, %opts, @extspec, @pass_through, $verbose);
  55
  56 foreach (@ARGV) {
  57     if (/^!(.*)$/) {
  58         $excl{$1} = 1;
  59     } elsif (/^\+(.*)$/) {
  60         $incl{$1} = 1;
  61     } elsif (/^--verbose$/ or /^-v$/) {
  62         $verbose = 1;
  63     } elsif (/^--([\w\-]+)$/) {
  64         $opts{$1} = 1;
  65     } elsif (/^--([\w\-]+)=(.*)$/) {
  66         push @{$opts{$1}}, $2;
  67     } elsif (/=/) {
  68         push @pass_through, $_;
  69     } elsif (length) {
  70         push @extspec, $_;
  71     }
  72 }
  73
  74 my $static = $opts{static} || $opts{all};
  75 my $dynamic = $opts{dynamic} || $opts{all};
  76 my $nonxs = $opts{nonxs} || $opts{all};
  77 my $dynaloader = $opts{dynaloader} || $opts{all};
  78
  79 # The Perl Makefile.SH will expand all extensions to
  80 #       lib/auto/X/X.a  (or lib/auto/X/Y/Y.a if nested)
  81 # A user wishing to run make_ext might use
  82 #       X (or X/Y or X::Y if nested)
  83
  84 # canonise into X/Y form (pname)
  85
  86 foreach (@extspec) {
  87     if (s{^lib/auto/}{}) {
  88         # Remove lib/auto prefix and /*.* suffix
  89         s{/[^/]+\.[^/]+$}{};
  90     } elsif (s{^$ext_dirs_re/}{}) {
  91         # Remove ext/ prefix and /pm_to_blib suffix
  92         s{/pm_to_blib$}{};
  93         # Targets are given as files on disk, but the extension spec is still
  94         # written using /s for each ::
  95         tr!-!/!;
  96     } elsif (s{::}{\/}g) {
  97         # Convert :: to /
  98     } else {
  99         s/\..*o//;
 100     }
 101 }
 102
 103 my $makecmd  = shift @pass_through; # Should be something like MAKE=make
 104 unshift @pass_through, 'PERL_CORE=1';
 105
 106 my @dirs  = @{$opts{dir} || \@ext_dirs};
 107 my $target   = $opts{target}[0];
 108 $target = 'all' unless defined $target;
 109
 110 # Previously, $make was taken from config.sh.  However, the user might
 111 # instead be running a possibly incompatible make.  This might happen if
 112 # the user types "gmake" instead of a plain "make", for example.  The
 113 # correct current value of MAKE will come through from the main perl
 114 # makefile as MAKE=/whatever/make in $makecmd.  We'll be cautious in
 115 # case third party users of this script (are there any?) don't have the
 116 # MAKE=$(MAKE) argument, which was added after 5.004_03.
 117 unless(defined $makecmd and $makecmd =~ /^MAKE=(.*)$/) {
 118     die "$0:  WARNING:  Please include MAKE=\$(MAKE) in \@ARGV\n";
 119 }
 120
 121 # This isn't going to cope with anything fancy, such as spaces inside command
 122 # names, but neither did what it replaced. Once there is a use case that needs
 123 # it, please supply patches. Until then, I'm sticking to KISS
 124 my @make = split ' ', $1 || $Config{make} || $ENV{MAKE};
 125
 126
 127 if ($target eq '') {
 128     die "make_ext: no make target specified (eg all or clean)\n";
 129 } elsif ($target !~ /^(?:all|clean|distclean|realclean|veryclean)$/) {
 130     # we are strict about what make_ext is used for because we emulate these
 131     # targets for simple modules:
 132     die "$0: unknown make target '$target'\n";
 133 }
 134
 135 if (!@extspec and !$static and !$dynamic and !$nonxs and !$dynaloader)  {
 136     die "$0: no extension specified\n";
 137 }
 138
 139 my $perl;
 140 my %extra_passthrough;
 141
 142 if ($is_Win32) {
 143     require Cwd;
 144     require FindExt;
 145     my $build = Cwd::getcwd();
 146     $perl = $^X;
 147     if ($perl =~ m#^\.\.#) {
 148         my $here = $build;
 149         $here =~ s{/}{\\}g;
 150         $perl = "$here\\$perl";
 151     }
 152     (my $topdir = $perl) =~ s/\\[^\\]+$//;
 153     # miniperl needs to find perlglob and pl2bat
 154     $ENV{PATH} = "$topdir;$topdir\\win32\\bin;$ENV{PATH}";
 155     my $pl2bat = "$topdir\\win32\\bin\\pl2bat";
 156     unless (-f "$pl2bat.bat") {
 157         my @args = ($perl, "-I$topdir\\lib", ("$pl2bat.pl") x 2);
 158         print "@args\n" if $verbose;
 159         system(@args) unless IS_CROSS;
 160     }
 161
 162     print "In $build" if $verbose;
 163     foreach my $dir (@dirs) {
 164         chdir($dir) or die "Cannot cd to $dir: $!\n";
 165         (my $ext = Cwd::getcwd()) =~ s{/}{\\}g;
 166         FindExt::scan_ext($ext);
 167         FindExt::set_static_extensions(split ' ', $Config{static_ext});
 168         chdir $build
 169             or die "Couldn't chdir to '$build': $!"; # restore our start directory
 170     }
 171
 172     my @ext;
 173     push @ext, FindExt::static_ext() if $static;
 174     push @ext, FindExt::dynamic_ext() if $dynamic;
 175     push @ext, FindExt::nonxs_ext() if $nonxs;
 176     push @ext, 'DynaLoader' if $dynaloader;
 177
 178     foreach (sort @ext) {
 179         if (%incl and !exists $incl{$_}) {
 180             #warn "Skipping extension $_, not in inclusion list\n";
 181             next;
 182         }
 183         if (exists $excl{$_}) {
 184             warn "Skipping extension $_, not ported to current platform";
 185             next;
 186         }
 187         push @extspec, $_;
 188         if($_ eq 'DynaLoader' and $target !~ /clean$/) {
 189             # No, we don't know why nmake can't work out the dependency chain
 190             push @{$extra_passthrough{$_}}, 'DynaLoader.c';
 191         } elsif(FindExt::is_static($_)) {
 192             push @{$extra_passthrough{$_}}, 'LINKTYPE=static';
 193         }
 194     }
 195
 196     chdir '..'
 197         or die "Couldn't chdir to build directory: $!"; # now in the Perl build
 198 }
 199 elsif ($is_VMS) {
 200     $perl = $^X;
 201     push @extspec, (split ' ', $Config{static_ext}) if $static;
 202     push @extspec, (split ' ', $Config{dynamic_ext}) if $dynamic;
 203     push @extspec, (split ' ', $Config{nonxs_ext}) if $nonxs;
 204     push @extspec, 'DynaLoader' if $dynaloader;
 205 }
 206
 207 {
 208     # Cwd needs to be built before Encode recurses into subdirectories.
 209     # Pod::Simple needs to be built before Pod::Functions
 210     # This seems to be the simplest way to ensure this ordering:
 211     my (@first, @other);
 212     foreach (@extspec) {
 213         if ($_ eq 'Cwd' || $_ eq 'Pod/Simple') {
 214             push @first, $_;
 215         } else {
 216             push @other, $_;
 217         }
 218     }
 219     @extspec = (@first, @other);
 220 }
 221
 222 if ($Config{osname} eq 'catamount' and @extspec) {
 223     # Snowball's chance of building extensions.
 224     die "This is $Config{osname}, not building $extspec[0], sorry.\n";
 225 }
 226
 227 foreach my $spec (@extspec)  {
 228     my $mname = $spec;
 229     $mname =~ s!/!::!g;
 230     my $ext_pathname;
 231
 232     # Try new style ext/Data-Dumper/ first
 233     my $copy = $spec;
 234     $copy =~ tr!/!-!;
 235
 236     # List/Util.xs lives in Scalar-List-Utils, Cwd.xs lives in PathTools
 237     $copy = 'Scalar-List-Utils' if $copy eq 'List-Util';
 238     $copy = 'PathTools'         if $copy eq 'Cwd';
 239
 240     foreach my $dir (@ext_dirs) {
 241         if (-d "$dir/$copy") {
 242             $ext_pathname = "$dir/$copy";
 243             last;
 244         }
 245     }
 246
 247     if (!defined $ext_pathname) {
 248         if (-d "ext/$spec") {
 249             # Old style ext/Data/Dumper/
 250             $ext_pathname = "ext/$spec";
 251         } else {
 252             warn "Can't find extension $spec in any of @ext_dirs";
 253             next;
 254         }
 255     }
 256
 257     print "\tMaking $mname ($target)\n" if $verbose;
 258
 259     build_extension($ext_pathname, $perl, $mname, $target,
 260                     [@pass_through, @{$extra_passthrough{$spec} || []}]);
 261 }
 262
 263 sub build_extension {
 264     my ($ext_dir, $perl, $mname, $target, $pass_through) = @_;
 265
 266     unless (chdir "$ext_dir") {
 267         warn "Cannot cd to $ext_dir: $!";
 268         return;
 269     }
 270
 271     my $up = $ext_dir;
 272     $up =~ s![^/]+!..!g;
 273
 274     $perl ||= "$up/miniperl";
 275     my $return_dir = $up;
 276     my $lib_dir = "$up/lib";
 277     $ENV{PERL_CORE} = 1;
 278
 279     my $makefile;
 280     if ($is_VMS) {
 281         $makefile = 'descrip.mms';
 282         if ($target =~ /clean$/
 283             && !-f $makefile
 284             && -f "${makefile}_old") {
 285             $makefile = "${makefile}_old";
 286         }
 287     } else {
 288         $makefile = 'Makefile';
 289     }
 290
 291     if (-f $makefile) {
 292         open my $mfh, $makefile or die "Cannot open $makefile: $!";
 293         while (<$mfh>) {
 294             # Plagiarised from CPAN::Distribution
 295             last if /MakeMaker post_initialize section/;
 296             next unless /^#\s+VERSION_FROM\s+=>\s+(.+)/;
 297             my $vmod = eval $1;
 298             my $oldv;
 299             while (<$mfh>) {
 300                 next unless /^XS_VERSION = (\S+)/;
 301                 $oldv = $1;
 302                 last;
 303             }
 304             last unless defined $oldv;
 305             require ExtUtils::MM_Unix;
 306             defined (my $newv = parse_version MM $vmod) or last;
 307             if ($newv ne $oldv) {
 308                 close $mfh or die "close $makefile: $!";
 309                 _unlink($makefile);
 310                 {
 311                     no warnings 'deprecated';
 312                     goto NO_MAKEFILE;
 313                 }
 314             }
 315         }
 316
 317         if (IS_CROSS) {
 318             # If we're cross-compiling, it's possible that the host's
 319             # Makefiles are around.
 320             seek($mfh, 0, 0) or die "Cannot seek $makefile: $!";
 321
 322             my $cross_makefile;
 323             while (<$mfh>) {
 324                 # XXX This might not be throughout enough.
 325                 # For example, it's possible to cause a false-positive
 326                 # if cross compiling on and for the Raspberry Pi,
 327                 # which is insane but plausible.
 328                 # False positives are really not troublesome, though;
 329                 # all they mean is that the module gets rebuilt.
 330                 if (/^CC = \Q$Config{cc}\E/) {
 331                     $cross_makefile = 1;
 332                     last;
 333                 }
 334             }
 335
 336             if (!$cross_makefile) {
 337                 print "Deleting non-Cross makefile\n";
 338                 close $mfh or die "close $makefile: $!";
 339                 _unlink($makefile);
 340             }
 341         }
 342     }
 343
 344     if (!-f $makefile) {
 345         NO_MAKEFILE:
 346         if (!-f 'Makefile.PL') {
 347             unless (just_pm_to_blib($target, $ext_dir, $mname, $return_dir)) {
 348                 # No problems returned, so it has faked everything for us. :-)
 349                 chdir $return_dir || die "Cannot cd to $return_dir: $!";
 350                 return;
 351             }
 352
 353             print "\nCreating Makefile.PL in $ext_dir for $mname\n" if $verbose;
 354             my ($fromname, $key, $value);
 355             if ($mname eq 'podlators') {
 356                 # We need to special case this somewhere, and this is fewer
 357                 # lines of code than a core-only Makefile.PL, and no more
 358                 # complex
 359                 $fromname = 'VERSION';
 360                 $key = 'DISTNAME';
 361                 $value = 'podlators';
 362                 $mname = 'Pod';
 363             } else {
 364                 $key = 'ABSTRACT_FROM';
 365                 # We need to cope well with various possible layouts
 366                 my @dirs = split /::/, $mname;
 367                 my $leaf = pop @dirs;
 368                 my $leafname = "$leaf.pm";
 369                 my $pathname = join '/', @dirs, $leafname;
 370                 my @locations = ($leafname, $pathname, "lib/$pathname");
 371                 unshift @locations, 'lib/IO/Compress/Base.pm' if $mname eq 'IO::Compress';
 372                 foreach (@locations) {
 373                     if (-f $_) {
 374                         $fromname = $_;
 375                         last;
 376                     }
 377                 }
 378
 379                 unless ($fromname) {
 380                     die "For $mname tried @locations in in $ext_dir but can't find source";
 381                 }
 382                 ($value = $fromname) =~ s/\.pm\z/.pod/;
 383                 $value = $fromname unless -e $value;
 384             }
 385             open my $fh, '>', 'Makefile.PL'
 386                 or die "Can't open Makefile.PL for writing: $!";
 387             printf $fh <<'EOM', $0, $mname, $fromname, $key, $value;
 388 #-*- buffer-read-only: t -*-
 389
 390 # This Makefile.PL was written by %s.
 391 # It will be deleted automatically by make realclean
 392
 393 use strict;
 394 use ExtUtils::MakeMaker;
 395
 396 # This is what the .PL extracts to. Not the ultimate file that is installed.
 397 # (ie Win32 runs pl2bat after this)
 398
 399 # Doing this here avoids all sort of quoting issues that would come from
 400 # attempting to write out perl source with literals to generate the arrays and
 401 # hash.
 402 my @temps = 'Makefile.PL';
 403 foreach (glob('scripts/pod*.PL')) {
 404     # The various pod*.PL extractors change directory. Doing that with relative
 405     # paths in @INC breaks. It seems the lesser of two evils to copy (to avoid)
 406     # the chdir doing anything, than to attempt to convert lib paths to
 407     # absolute, and potentially run into problems with quoting special
 408     # characters in the path to our build dir (such as spaces)
 409     require File::Copy;
 410
 411     my $temp = $_;
 412     $temp =~ s!scripts/!!;
 413     File::Copy::copy($_, $temp) or die "Can't copy $temp to $_: $!";
 414     push @temps, $temp;
 415 }
 416
 417 my $script_ext = $^O eq 'VMS' ? '.com' : '';
 418 my %%pod_scripts;
 419 foreach (glob('pod*.PL')) {
 420     my $script = $_;
 421     s/.PL$/$script_ext/i;
 422     $pod_scripts{$script} = $_;
 423 }
 424 my @exe_files = values %%pod_scripts;
 425
 426 WriteMakefile(
 427     NAME          => '%s',
 428     VERSION_FROM  => '%s',
 429     %-13s => '%s',
 430     realclean     => { FILES => "@temps" },
 431     (%%pod_scripts ? (
 432         PL_FILES  => \%%pod_scripts,
 433         EXE_FILES => \@exe_files,
 434         clean     => { FILES => "@exe_files" },
 435     ) : ()),
 436 );
 437
 438 # ex: set ro:
 439 EOM
 440             close $fh or die "Can't close Makefile.PL: $!";
 441             # As described in commit 23525070d6c0e51f:
 442             # Push the atime and mtime of generated Makefile.PLs back 4
 443             # seconds. In certain circumstances ( on virtual machines ) the
 444             # generated Makefile.PL can produce a Makefile that is older than
 445             # the Makefile.PL. Altering the atime and mtime backwards by 4
 446             # seconds seems to resolve the issue.
 447             eval {
 448                 my $ftime = time - 4;
 449                 utime $ftime, $ftime, 'Makefile.PL';
 450             };
 451         } elsif ($mname =~ /\A(?:Carp
 452                             |ExtUtils::CBuilder
 453                             |Safe
 454                             |Search::Dict)\z/x) {
 455             # An explicit list of dual-life extensions that have a Makefile.PL
 456             # for CPAN, but we have verified can also be built using the fakery.
 457             my ($problem) = just_pm_to_blib($target, $ext_dir, $mname, $return_dir);
 458             # We really need to sanity test that we can fake it.
 459             # Otherwise "skips" will go undetected, and the build slow down for
 460             # everyone, defeating the purpose.
 461             if (defined $problem) {
 462                 if (-d "$return_dir/.git") {
 463                     # Get the list of files that git isn't ignoring:
 464                     my @files = `git ls-files --cached --others --exclude-standard 2>/dev/null`;
 465                     # on error (eg no git) we get nothing, but that's not a
 466                     # problem. The goal is to see if git thinks that the problem
 467                     # file is interesting, by getting a positive match with
 468                     # something git told us about, and if so bail out:
 469                     foreach (@files) {
 470                         chomp;
 471                         # We really need to sanity test that we can fake it.
 472                         # The intent is that this should only fail because
 473                         # you've just added a file to the dual-life dist that
 474                         # we can't handle. In which case you should either
 475                         # 1) remove the dist from the regex a few lines above.
 476                         # or
 477                         # 2) add the file to regex of "safe" filenames earlier
 478                         #    in this function, that starts with ChangeLog
 479                         die "FATAL - $0 has $mname in the list of simple extensions, but it now contains file '$problem' which we can't handle"
 480                             if $problem eq $_;
 481                     }
 482                     # There's an unexpected file, but it seems to be something
 483                     # that git will ignore. So fall through to the regular
 484                     # Makefile.PL handling code below, on the assumption that
 485                     # we won't get here for a clean build.
 486                 }
 487                 warn "WARNING - $0 is building $mname using EU::MM, as it found file '$problem'";
 488             } else {
 489                 # It faked everything for us.
 490                 chdir $return_dir || die "Cannot cd to $return_dir: $!";
 491                 return;
 492             }
 493         }
 494
 495         # We are going to have to use Makefile.PL:
 496         print "\nRunning Makefile.PL in $ext_dir\n" if $verbose;
 497
 498         my @args = ("-I$lib_dir", 'Makefile.PL');
 499         if ($is_VMS) {
 500             my $libd = VMS::Filespec::vmspath($lib_dir);
 501             push @args, "INST_LIB=$libd", "INST_ARCHLIB=$libd";
 502         } else {
 503             push @args, 'INSTALLDIRS=perl', 'INSTALLMAN1DIR=none',
 504                 'INSTALLMAN3DIR=none';
 505         }
 506         push @args, @$pass_through;
 507         _quote_args(\@args) if $is_VMS;
 508         print join(' ', $perl, @args), "\n" if $verbose;
 509         my $code = system $perl, @args;
 510         warn "$code from $ext_dir\'s Makefile.PL" if $code;
 511
 512         # Right. The reason for this little hack is that we're sitting inside
 513         # a program run by ./miniperl, but there are tasks we need to perform
 514         # when the 'realclean', 'distclean' or 'veryclean' targets are run.
 515         # Unfortunately, they can be run *after* 'clean', which deletes
 516         # ./miniperl
 517         # So we do our best to leave a set of instructions identical to what
 518         # we would do if we are run directly as 'realclean' etc
 519         # Whilst we're perfect, unfortunately the targets we call are not, as
 520         # some of them rely on a $(PERL) for their own distclean targets.
 521         # But this always used to be a problem with the old /bin/sh version of
 522         # this.
 523         if ($is_Unix) {
 524             foreach my $clean_target ('realclean', 'veryclean') {
 525                 fallback_cleanup($return_dir, $clean_target, <<"EOS");
 526 cd $ext_dir
 527 if test ! -f Makefile -a -f Makefile.old; then
 528     echo "Note: Using Makefile.old"
 529     make -f Makefile.old $clean_target MAKE='@make' @pass_through
 530 else
 531     if test ! -f Makefile ; then
 532         echo "Warning: No Makefile!"
 533     fi
 534     @make $clean_target MAKE='@make' @pass_through
 535 fi
 536 cd $return_dir
 537 EOS
 538             }
 539         }
 540     }
 541
 542     if (not -f $makefile) {
 543         print "Warning: No Makefile!\n";
 544     }
 545
 546     if ($is_VMS) {
 547         _quote_args($pass_through);
 548         @$pass_through = (
 549                           "/DESCRIPTION=$makefile",
 550                           '/MACRO=(' . join(',',@$pass_through) . ')'
 551                          );
 552     }
 553
 554     if (!$target or $target !~ /clean$/) {
 555         # Give makefile an opportunity to rewrite itself.
 556         # reassure users that life goes on...
 557         my @args = ('config', @$pass_through);
 558         system(@make, @args) and print "@make @args failed, continuing anyway...\n";
 559     }
 560     my @targ = ($target, @$pass_through);
 561     print "Making $target in $ext_dir\n@make @targ\n" if $verbose;
 562     local $ENV{PERL_INSTALL_QUIET} = 1;
 563     my $code = system(@make, @targ);
 564     die "Unsuccessful make($ext_dir): code=$code" if $code != 0;
 565
 566     chdir $return_dir || die "Cannot cd to $return_dir: $!";
 567 }
 568
 569 sub _quote_args {
 570     my $args = shift; # must be array reference
 571
 572     # Do not quote qualifiers that begin with '/'.
 573     map { if (!/^\//) {
 574           $_ =~ s/\"/""/g;     # escape C<"> by doubling
 575           $_ = q(").$_.q(");
 576         }
 577     } @{$args}
 578     ;
 579 }
 580
 581 #guarentee that a file is deleted or die, void _unlink($filename)
 582 #xxx replace with _unlink_or_rename from EU::Install?
 583 sub _unlink {
 584     1 while unlink $_[0];
 585     my $err = $!;
 586     die "Can't unlink $_[0]: $err" if -f $_[0];
 587 }
 588
 589 # Figure out if this extension is simple enough that it would only use
 590 # ExtUtils::MakeMaker's pm_to_blib target. If we're confident that it would,
 591 # then do all the work ourselves (returning an empty list), else return the
 592 # name of a file that we identified as beyond our ability to handle.
 593 #
 594 # While this is clearly quite a bit more work than just letting
 595 # ExtUtils::MakeMaker do it, and effectively is some code duplication, the time
 596 # savings are impressive.
 597
 598 sub just_pm_to_blib {
 599     my ($target, $ext_dir, $mname, $return_dir) = @_;
 600     my ($has_lib, $has_top, $has_topdir);
 601     my ($last) = $mname =~ /([^:]+)$/;
 602     my ($first) = $mname =~ /^([^:]+)/;
 603
 604     my $pm_to_blib = $is_VMS ? 'pm_to_blib.ts' : 'pm_to_blib';
 605
 606     foreach my $leaf (<*>) {
 607         if (-d $leaf) {
 608             $leaf =~ s/\.DIR\z//i
 609                 if $is_VMS;
 610             next if $leaf =~ /\A(?:\.|\.\.|t|demo)\z/;
 611             if ($leaf eq 'lib') {
 612                 ++$has_lib;
 613                 next;
 614             }
 615             if ($leaf eq $first) {
 616                 ++$has_topdir;
 617                 next;
 618             }
 619         }
 620         return $leaf
 621             unless -f _;
 622         $leaf =~ s/\.\z//
 623             if $is_VMS;
 624         # Makefile.PL is "safe" to ignore because we will only be called for
 625         # directories that hold a Makefile.PL if they are in the exception list.
 626         next
 627             if $leaf =~ /\A(ChangeLog
 628                             |Changes
 629                             |LICENSE
 630                             |Makefile\.PL
 631                             |MANIFEST
 632                             |META\.yml
 633                             |\Q$pm_to_blib\E
 634                             |README
 635                             |README\.patching
 636                             |README\.release
 637                             )\z/xi; # /i to deal with case munging systems.
 638         if ($leaf eq "$last.pm") {
 639             ++$has_top;
 640             next;
 641         }
 642         return $leaf;
 643     }
 644     return 'no lib/'
 645         unless $has_lib || $has_top;
 646     die "Inconsistent module $mname has both lib/ and $first/"
 647         if $has_lib && $has_topdir;
 648
 649     print "\nRunning pm_to_blib for $ext_dir directly\n";
 650
 651     my %pm;
 652     if ($has_top) {
 653         my $to = $mname =~ s!::!/!gr;
 654         $pm{"$last.pm"} = "../../lib/$to.pm";
 655     }
 656     if ($has_lib || $has_topdir) {
 657         # strictly ExtUtils::MakeMaker uses the pm_to_blib target to install
 658         # .pm, pod and .pl files. We're just going to do it for .pm and .pod
 659         # files, to avoid problems on case munging file systems. Specifically,
 660         # _pm.PL which ExtUtils::MakeMaker should run munges to _PM.PL, and
 661         # looks a lot like a regular foo.pl (ie FOO.PL)
 662         my @found;
 663         require File::Find;
 664         unless (eval {
 665             File::Find::find({
 666                               no_chdir => 1,
 667                               wanted => sub {
 668                                   return if -d $_;
 669                                   # Bail out immediately with the problem file:
 670                                   die \$_
 671                                       unless -f _;
 672                                   die \$_
 673                                       unless /\A[^.]+\.(?:pm|pod)\z/i;
 674                                   push @found, $_;
 675                               }
 676                              }, $has_lib ? 'lib' : $first);
 677             1;
 678         }) {
 679             # Problem files aren't really errors:
 680             return ${$@}
 681                 if ref $@ eq 'SCALAR';
 682             # But anything else is:
 683             die $@;
 684         }
 685         if ($has_lib) {
 686             $pm{$_} = "../../$_"
 687                 foreach @found;
 688         } else {
 689             $pm{$_} = "../../lib/$_"
 690                 foreach @found;
 691         }
 692     }
 693     # This is running under miniperl, so no autodie
 694     if ($target eq 'all') {
 695         local $ENV{PERL_INSTALL_QUIET} = 1;
 696         require ExtUtils::Install;
 697         ExtUtils::Install::pm_to_blib(\%pm, '../../lib/auto');
 698         open my $fh, '>', $pm_to_blib
 699             or die "Can't open '$pm_to_blib': $!";
 700         print $fh "$0 has handled pm_to_blib directly\n";
 701         close $fh
 702             or die "Can't close '$pm_to_blib': $!";
 703         if ($is_Unix) {
 704             # Fake the fallback cleanup
 705             my $fallback
 706                 = join '', map {s!^\.\./\.\./!!; "rm -f $_\n"} sort values %pm;
 707             foreach my $clean_target ('realclean', 'veryclean') {
 708                 fallback_cleanup($return_dir, $clean_target, $fallback);
 709             }
 710         }
 711     } else {
 712         # A clean target.
 713         # For now, make the targets behave the same way as ExtUtils::MakeMaker
 714         # does
 715         _unlink($pm_to_blib);
 716         unless ($target eq 'clean') {
 717             # but cheat a bit, by relying on the top level Makefile clean target
 718             # to take out our directory lib/auto/...
 719             # (which it has to deal with, as cpan/foo/bar creates
 720             # lib/auto/foo/bar, but the EU::MM rule will only
 721             # rmdir lib/auto/foo/bar, leaving lib/auto/foo
 722             _unlink("../../$_")
 723                 foreach sort values %pm;
 724         }
 725     }
 726     return;
 727 }
 728
 729 sub fallback_cleanup {
 730     my ($dir, $clean_target, $contents) = @_;
 731     my $file = "$dir/$clean_target.sh";
 732     open my $fh, '>>', $file or die "open $file: $!";
 733     # Quite possible that we're being run in parallel here.
 734     # Can't use Fcntl this early to get the LOCK_EX
 735     flock $fh, 2 or warn "flock $file: $!";
 736     print $fh $contents or die "print $file: $!";
 737     close $fh or die "close $file: $!";
 738 }