local-lib5/lib/perl5/Module/Build/Compat.pm

   1 package Module::Build::Compat;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5 $VERSION = '0.35';
   6
   7 use File::Basename ();
   8 use File::Spec;
   9 use IO::File;
  10 use Config;
  11 use Module::Build;
  12 use Module::Build::ModuleInfo;
  13 use Data::Dumper;
  14
  15 my %convert_installdirs = (
  16     PERL        => 'core',
  17     SITE        => 'site',
  18     VENDOR      => 'vendor',
  19 );
  20
  21 my %makefile_to_build =
  22   (
  23    TEST_VERBOSE => 'verbose',
  24    VERBINST     => 'verbose',
  25    INC          => sub { map {(extra_compiler_flags => $_)} Module::Build->split_like_shell(shift) },
  26    POLLUTE      => sub { (extra_compiler_flags => '-DPERL_POLLUTE') },
  27    INSTALLDIRS  => sub { (installdirs => $convert_installdirs{uc shift()}) },
  28    LIB          => sub {
  29        my $lib = shift;
  30        my %config = (
  31            installprivlib  => $lib,
  32            installsitelib  => $lib,
  33            installarchlib  => "$lib/$Config{archname}",
  34            installsitearch => "$lib/$Config{archname}"
  35        );
  36        return map { (config => "$_=$config{$_}") } keys %config;
  37    },
  38
  39    # Convert INSTALLVENDORLIB and friends.
  40    (
  41        map {
  42            my $name = $_;
  43            $name => sub {
  44                  my @ret = (config => lc($name) . "=" . shift );
  45                  print STDERR "# Converted to @ret\n";
  46
  47                  return @ret;
  48            }
  49        } qw(
  50          INSTALLARCHLIB  INSTALLSITEARCH     INSTALLVENDORARCH
  51          INSTALLPRIVLIB  INSTALLSITELIB      INSTALLVENDORLIB
  52          INSTALLBIN      INSTALLSITEBIN      INSTALLVENDORBIN
  53          INSTALLSCRIPT   INSTALLSITESCRIPT   INSTALLVENDORSCRIPT
  54          INSTALLMAN1DIR  INSTALLSITEMAN1DIR  INSTALLVENDORMAN1DIR
  55          INSTALLMAN3DIR  INSTALLSITEMAN3DIR  INSTALLVENDORMAN3DIR
  56        )
  57    ),
  58
  59    # Some names they have in common
  60    map {$_, lc($_)} qw(DESTDIR PREFIX INSTALL_BASE UNINST),
  61   );
  62
  63 my %macro_to_build = %makefile_to_build;
  64 # "LIB=foo make" is not the same as "perl Makefile.PL LIB=foo"
  65 delete $macro_to_build{LIB};
  66
  67
  68 sub create_makefile_pl {
  69   my ($package, $type, $build, %args) = @_;
  70
  71   die "Don't know how to build Makefile.PL of type '$type'"
  72     unless $type =~ /^(small|passthrough|traditional)$/;
  73
  74   my $fh;
  75   if ($args{fh}) {
  76     $fh = $args{fh};
  77   } else {
  78     $args{file} ||= 'Makefile.PL';
  79     local $build->{properties}{quiet} = 1;
  80     $build->delete_filetree($args{file});
  81     $fh = IO::File->new("> $args{file}") or die "Can't write $args{file}: $!";
  82   }
  83
  84   print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";
  85
  86   # Minimum perl version should be specified as "require 5.XXXXXX" in
  87   # Makefile.PL
  88   my $requires = $build->requires;
  89   if ( my $minimum_perl = $requires->{perl} ) {
  90     print {$fh} "require $minimum_perl;\n";
  91   }
  92
  93   # If a *bundled* custom subclass is being used, make sure we add its
  94   # directory to @INC.  Also, lib.pm always needs paths in Unix format.
  95   my $subclass_load = '';
  96   if (ref($build) ne "Module::Build") {
  97     my $subclass_dir = $package->subclass_dir($build);
  98
  99     if (File::Spec->file_name_is_absolute($subclass_dir)) {
 100       my $base_dir = $build->base_dir;
 101
 102       if ($build->dir_contains($base_dir, $subclass_dir)) {
 103         $subclass_dir = File::Spec->abs2rel($subclass_dir, $base_dir);
 104         $subclass_dir = $package->unixify_dir($subclass_dir);
 105         $subclass_load = "use lib '$subclass_dir';";
 106       }
 107       # Otherwise, leave it the empty string
 108
 109     } else {
 110       $subclass_dir = $package->unixify_dir($subclass_dir);
 111       $subclass_load = "use lib '$subclass_dir';";
 112     }
 113   }
 114
 115   if ($type eq 'small') {
 116     printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
 117     use Module::Build::Compat 0.02;
 118     %s
 119     Module::Build::Compat->run_build_pl(args => \@ARGV);
 120     require %s;
 121     Module::Build::Compat->write_makefile(build_class => '%s');
 122 EOF
 123
 124   } elsif ($type eq 'passthrough') {
 125     printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
 126
 127     unless (eval "use Module::Build::Compat 0.02; 1" ) {
 128       print "This module requires Module::Build to install itself.\n";
 129
 130       require ExtUtils::MakeMaker;
 131       my $yn = ExtUtils::MakeMaker::prompt
 132         ('  Install Module::Build now from CPAN?', 'y');
 133
 134       unless ($yn =~ /^y/i) {
 135         die " *** Cannot install without Module::Build.  Exiting ...\n";
 136       }
 137
 138       require Cwd;
 139       require File::Spec;
 140       require CPAN;
 141
 142       # Save this 'cause CPAN will chdir all over the place.
 143       my $cwd = Cwd::cwd();
 144
 145       CPAN::Shell->install('Module::Build::Compat');
 146       CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
 147         or die "Couldn't install Module::Build, giving up.\n";
 148
 149       chdir $cwd or die "Cannot chdir() back to $cwd: $!";
 150     }
 151     eval "use Module::Build::Compat 0.02; 1" or die $@;
 152     %s
 153     Module::Build::Compat->run_build_pl(args => \@ARGV);
 154     my $build_script = 'Build';
 155     $build_script .= '.com' if $^O eq 'VMS';
 156     exit(0) unless(-e $build_script); # cpantesters convention
 157     require %s;
 158     Module::Build::Compat->write_makefile(build_class => '%s');
 159 EOF
 160
 161   } elsif ($type eq 'traditional') {
 162
 163     my (%MM_Args, %prereq);
 164     if (eval "use Tie::IxHash; 1") {
 165       tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
 166       tie %prereq,  'Tie::IxHash'; # Don't care if it fails here
 167     }
 168
 169     my %name = ($build->module_name
 170                 ? (NAME => $build->module_name)
 171                 : (DISTNAME => $build->dist_name));
 172
 173     my %version = ($build->dist_version_from
 174                    ? (VERSION_FROM => $build->dist_version_from)
 175                    : (VERSION      => $build->dist_version)
 176                   );
 177     %MM_Args = (%name, %version);
 178
 179     %prereq = ( %{$build->requires}, %{$build->build_requires} );
 180     %prereq = map {$_, $prereq{$_}} sort keys %prereq;
 181
 182      delete $prereq{perl};
 183     $MM_Args{PREREQ_PM} = \%prereq;
 184
 185     $MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs;
 186
 187     $MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
 188
 189     $MM_Args{PL_FILES} = $build->PL_files || {};
 190
 191     if ($build->recursive_test_files) {
 192         $MM_Args{TESTS} = join q{ }, $package->_test_globs($build);
 193     }
 194
 195     local $Data::Dumper::Terse = 1;
 196     my $args = Data::Dumper::Dumper(\%MM_Args);
 197     $args =~ s/\{(.*)\}/($1)/s;
 198
 199     print $fh <<"EOF";
 200 use ExtUtils::MakeMaker;
 201 WriteMakefile
 202 $args;
 203 EOF
 204   }
 205 }
 206
 207 sub _test_globs {
 208   my ($self, $build) = @_;
 209
 210   return map { File::Spec->catfile($_, '*.t') }
 211          @{$build->rscan_dir('t', sub { -d $File::Find::name })};
 212 }
 213
 214 sub subclass_dir {
 215   my ($self, $build) = @_;
 216
 217   return (Module::Build::ModuleInfo->find_module_dir_by_name(ref $build)
 218           || File::Spec->catdir($build->config_dir, 'lib'));
 219 }
 220
 221 sub unixify_dir {
 222   my ($self, $path) = @_;
 223   return join '/', File::Spec->splitdir($path);
 224 }
 225
 226 sub makefile_to_build_args {
 227   my $class = shift;
 228   my @out;
 229   foreach my $arg (@_) {
 230     next if $arg eq '';
 231
 232     my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) :
 233                        die "Malformed argument '$arg'");
 234
 235     # Do tilde-expansion if it looks like a tilde prefixed path
 236     ( $val ) = Module::Build->_detildefy( $val ) if $val =~ /^~/;
 237
 238     if (exists $makefile_to_build{$key}) {
 239       my $trans = $makefile_to_build{$key};
 240       push @out, $class->_argvify( ref($trans) ? $trans->($val) : ($trans => $val) );
 241     } elsif (exists $Config{lc($key)}) {
 242       push @out, $class->_argvify( config => lc($key) . "=$val" );
 243     } else {
 244       # Assume M::B can handle it in lowercase form
 245       push @out, $class->_argvify("\L$key" => $val);
 246     }
 247   }
 248   return @out;
 249 }
 250
 251 sub _argvify {
 252   my ($self, @pairs) = @_;
 253   my @out;
 254   while (@pairs) {
 255     my ($k, $v) = splice @pairs, 0, 2;
 256     push @out, ("--$k", $v);
 257   }
 258   return @out;
 259 }
 260
 261 sub makefile_to_build_macros {
 262   my @out;
 263   my %config; # must accumulate and return as a hashref
 264   while (my ($macro, $trans) = each %macro_to_build) {
 265     # On some platforms (e.g. Cygwin with 'make'), the mere presence
 266     # of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined.
 267     # Therefore we check length() too.
 268     next unless exists $ENV{$macro} && length $ENV{$macro};
 269     my $val = $ENV{$macro};
 270     my @args = ref($trans) ? $trans->($val) : ($trans => $val);
 271     while (@args) {
 272       my ($k, $v) = splice(@args, 0, 2);
 273       if ( $k eq 'config' ) {
 274         if ( $v =~ /^([^=]+)=(.*)$/ ) {
 275           $config{$1} = $2;
 276         }
 277         else {
 278           warn "Couldn't parse config '$v'\n";
 279         }
 280       }
 281       else {
 282         push @out, ($k => $v);
 283       }
 284     }
 285   }
 286   push @out, (config => \%config) if %config;
 287   return @out;
 288 }
 289
 290 sub run_build_pl {
 291   my ($pack, %in) = @_;
 292   $in{script} ||= 'Build.PL';
 293   my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : ();
 294   print "# running $in{script} @args\n";
 295   Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!";
 296 }
 297
 298 sub fake_makefile {
 299   my ($self, %args) = @_;
 300   unless (exists $args{build_class}) {
 301     warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
 302     $args{build_class} = 'Module::Build';
 303   }
 304   my $class = $args{build_class};
 305
 306   my $perl = $class->find_perl_interpreter;
 307
 308   # VMS MMS/MMK need to use MCR to run the Perl image.
 309   $perl = 'MCR ' . $perl if $self->_is_vms_mms;
 310
 311   my $noop = ($class->is_windowsish ? 'rem>nul'  :
 312               $self->_is_vms_mms    ? 'Continue' :
 313               'true');
 314
 315   my $filetype = $class->is_vmsish ? '.COM' : '';
 316
 317   my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
 318   my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
 319   $unlink =~ s/\$/\$\$/g unless $class->is_vmsish;
 320
 321   my $maketext = ($^O eq 'os2' ? "SHELL = sh\n\n" : '');
 322
 323   $maketext .= <<"EOF";
 324 all : force_do_it
 325         $perl $Build
 326 realclean : force_do_it
 327         $perl $Build realclean
 328         $unlink
 329 distclean : force_do_it
 330         $perl $Build distclean
 331         $unlink
 332
 333
 334 force_do_it :
 335         @ $noop
 336 EOF
 337
 338   foreach my $action ($class->known_actions) {
 339     next if $action =~ /^(all|distclean|realclean|force_do_it)$/;  # Don't double-define
 340     $maketext .= <<"EOF";
 341 $action : force_do_it
 342         $perl $Build $action
 343 EOF
 344   }
 345
 346   if ($self->_is_vms_mms) {
 347     # Roll our own .EXPORT as MMS/MMK don't honor that directive.
 348     $maketext .= "\n.FIRST\n\t\@ $noop\n";
 349     for my $macro (keys %macro_to_build) {
 350       $maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n";
 351     }
 352     $maketext .= "\n";
 353   }
 354   else {
 355     $maketext .= "\n.EXPORT : " . join(' ', keys %macro_to_build) . "\n\n";
 356   }
 357
 358   return $maketext;
 359 }
 360
 361 sub fake_prereqs {
 362   my $file = File::Spec->catfile('_build', 'prereqs');
 363   my $fh = IO::File->new("< $file") or die "Can't read $file: $!";
 364   my $prereqs = eval do {local $/; <$fh>};
 365   close $fh;
 366
 367   my @prereq;
 368   foreach my $section (qw/build_requires requires/) {
 369     foreach (keys %{$prereqs->{$section}}) {
 370       next if $_ eq 'perl';
 371       push @prereq, "$_=>q[$prereqs->{$section}{$_}]";
 372     }
 373   }
 374
 375   return unless @prereq;
 376   return "#     PREREQ_PM => { " . join(", ", @prereq) . " }\n\n";
 377 }
 378
 379
 380 sub write_makefile {
 381   my ($pack, %in) = @_;
 382
 383   unless (exists $in{build_class}) {
 384     warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
 385     $in{build_class} = 'Module::Build';
 386   }
 387   my $class = $in{build_class};
 388   $in{makefile} ||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile';
 389
 390   open  MAKE, "> $in{makefile}" or die "Cannot write $in{makefile}: $!";
 391   print MAKE $pack->fake_prereqs;
 392   print MAKE $pack->fake_makefile(%in);
 393   close MAKE;
 394 }
 395
 396 sub _is_vms_mms {
 397   return Module::Build->is_vmsish && ($Config{make} =~ m/MM[SK]/i);
 398 }
 399
 400 1;
 401 __END__
 402
 403 =for :stopwords passthrough
 404
 405 =head1 NAME
 406
 407 Module::Build::Compat - Compatibility with ExtUtils::MakeMaker
 408
 409
 410 =head1 SYNOPSIS
 411
 412   # In a Build.PL :
 413   use Module::Build;
 414   my $build = Module::Build->new
 415     ( module_name => 'Foo::Bar',
 416       license     => 'perl',
 417       create_makefile_pl => 'passthrough' );
 418   ...
 419
 420
 421 =head1 DESCRIPTION
 422
 423 Because C<ExtUtils::MakeMaker> has been the standard way to distribute
 424 modules for a long time, many tools (CPAN.pm, or your system
 425 administrator) may expect to find a working F<Makefile.PL> in every
 426 distribution they download from CPAN.  If you want to throw them a
 427 bone, you can use C<Module::Build::Compat> to automatically generate a
 428 F<Makefile.PL> for you, in one of several different styles.
 429
 430 C<Module::Build::Compat> also provides some code that helps out the
 431 F<Makefile.PL> at runtime.
 432
 433
 434 =head1 METHODS
 435
 436 =over 4
 437
 438 =item create_makefile_pl($style, $build)
 439
 440 Creates a F<Makefile.PL> in the current directory in one of several
 441 styles, based on the supplied C<Module::Build> object C<$build>.  This is
 442 typically controlled by passing the desired style as the
 443 C<create_makefile_pl> parameter to C<Module::Build>'s C<new()> method;
 444 the F<Makefile.PL> will then be automatically created during the
 445 C<distdir> action.
 446
 447 The currently supported styles are:
 448
 449 =over 4
 450
 451 =item small
 452
 453 A small F<Makefile.PL> will be created that passes all functionality
 454 through to the F<Build.PL> script in the same directory.  The user must
 455 already have C<Module::Build> installed in order to use this, or else
 456 they'll get a module-not-found error.
 457
 458 =item passthrough
 459
 460 This is just like the C<small> option above, but if C<Module::Build> is
 461 not already installed on the user's system, the script will offer to
 462 use C<CPAN.pm> to download it and install it before continuing with
 463 the build.
 464
 465 =item traditional
 466
 467 A F<Makefile.PL> will be created in the "traditional" style, i.e. it will
 468 use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all.
 469 In order to create the F<Makefile.PL>, we'll include the C<requires> and
 470 C<build_requires> dependencies as the C<PREREQ_PM> parameter.
 471
 472 You don't want to use this style if during the C<perl Build.PL> stage
 473 you ask the user questions, or do some auto-sensing about the user's
 474 environment, or if you subclass C<Module::Build> to do some
 475 customization, because the vanilla F<Makefile.PL> won't do any of that.
 476
 477 =back
 478
 479 =item run_build_pl(args => \@ARGV)
 480
 481 This method runs the F<Build.PL> script, passing it any arguments the
 482 user may have supplied to the C<perl Makefile.PL> command.  Because
 483 C<ExtUtils::MakeMaker> and C<Module::Build> accept different arguments, this
 484 method also performs some translation between the two.
 485
 486 C<run_build_pl()> accepts the following named parameters:
 487
 488 =over 4
 489
 490 =item args
 491
 492 The C<args> parameter specifies the parameters that would usually
 493 appear on the command line of the C<perl Makefile.PL> command -
 494 typically you'll just pass a reference to C<@ARGV>.
 495
 496 =item script
 497
 498 This is the filename of the script to run - it defaults to C<Build.PL>.
 499
 500 =back
 501
 502 =item write_makefile()
 503
 504 This method writes a 'dummy' F<Makefile> that will pass all commands
 505 through to the corresponding C<Module::Build> actions.
 506
 507 C<write_makefile()> accepts the following named parameters:
 508
 509 =over 4
 510
 511 =item makefile
 512
 513 The name of the file to write - defaults to the string C<Makefile>.
 514
 515 =back
 516
 517 =back
 518
 519
 520 =head1 SCENARIOS
 521
 522 So, some common scenarios are:
 523
 524 =over 4
 525
 526 =item 1.
 527
 528 Just include a F<Build.PL> script (without a F<Makefile.PL>
 529 script), and give installation directions in a F<README> or F<INSTALL>
 530 document explaining how to install the module.  In particular, explain
 531 that the user must install C<Module::Build> before installing your
 532 module.
 533
 534 Note that if you do this, you may make things easier for yourself, but
 535 harder for people with older versions of CPAN or CPANPLUS on their
 536 system, because those tools generally only understand the
 537 F<Makefile.PL>/C<ExtUtils::MakeMaker> way of doing things.
 538
 539 =item 2.
 540
 541 Include a F<Build.PL> script and a "traditional" F<Makefile.PL>,
 542 created either manually or with C<create_makefile_pl()>.  Users won't
 543 ever have to install C<Module::Build> if they use the F<Makefile.PL>, but
 544 they won't get to take advantage of C<Module::Build>'s extra features
 545 either.
 546
 547 For good measure, of course, test both the F<Makefile.PL> and the
 548 F<Build.PL> before shipping.
 549
 550 =item 3.
 551
 552 Include a F<Build.PL> script and a "pass-through" F<Makefile.PL>
 553 built using C<Module::Build::Compat>.  This will mean that people can
 554 continue to use the "old" installation commands, and they may never
 555 notice that it's actually doing something else behind the scenes.  It
 556 will also mean that your installation process is compatible with older
 557 versions of tools like CPAN and CPANPLUS.
 558
 559 =back
 560
 561
 562 =head1 AUTHOR
 563
 564 Ken Williams <kwilliams@cpan.org>
 565
 566
 567 =head1 COPYRIGHT
 568
 569 Copyright (c) 2001-2006 Ken Williams.  All rights reserved.
 570
 571 This library is free software; you can redistribute it and/or
 572 modify it under the same terms as Perl itself.
 573
 574
 575 =head1 SEE ALSO
 576
 577 L<Module::Build>(3), L<ExtUtils::MakeMaker>(3)
 578
 579
 580 =cut