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