cpan/Module-Build/lib/Module/Build/Compat.pm

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