home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / Compat.pm < prev    next >
Text File  |  2005-04-27  |  12KB  |  412 lines
  1. package Module::Build::Compat;
  2.  
  3. use strict;
  4. use vars qw($VERSION);
  5. $VERSION = '0.03';
  6.  
  7. use File::Spec;
  8. use IO::File;
  9. use Config;
  10. use Module::Build;
  11. use Data::Dumper;
  12.  
  13. my %makefile_to_build = 
  14.   (
  15.    TEST_VERBOSE => 'verbose',
  16.    VERBINST     => 'verbose',
  17.    INC     => sub { map {('--extra_compiler_flags', "-I$_")} Module::Build->split_like_shell(shift) },
  18.    POLLUTE => sub { ('--extra_compiler_flags', '-DPERL_POLLUTE') },
  19.    INSTALLDIRS => sub {local $_ = shift; 'installdirs=' . (/^perl$/ ? 'core' : $_) },
  20.    PREFIX => sub {die "Sorry, PREFIX is not supported.  See the Module::Build\n".
  21.               "documentation for 'destdir' or 'install_base' instead.\n"},
  22.    LIB => sub { ('--install_path', 'lib='.shift()) },
  23.   );
  24.  
  25.  
  26.  
  27. sub create_makefile_pl {
  28.   my ($package, $type, $build, %args) = @_;
  29.   
  30.   die "Don't know how to build Makefile.PL of type '$type'"
  31.     unless $type =~ /^(small|passthrough|traditional)$/;
  32.  
  33.   my $fh;
  34.   if ($args{fh}) {
  35.     $fh = $args{fh};
  36.   } else {
  37.     $args{file} ||= 'Makefile.PL';
  38.     $fh = IO::File->new("> $args{file}") or die "Can't write $args{file}: $!";
  39.   }
  40.  
  41.   print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";
  42.   my $subclass_dir = File::Spec->catdir($build->config_dir, 'lib');
  43.   $subclass_dir =~ s/([\'\\])/\\$1/g;
  44.   
  45.   if ($type eq 'small') {
  46.     printf {$fh} <<'EOF', $subclass_dir, ref($build), ref($build);
  47.     use Module::Build::Compat 0.02;
  48.     use lib '%s';
  49.     Module::Build::Compat->run_build_pl(args => \@ARGV);
  50.     require %s;
  51.     Module::Build::Compat->write_makefile(build_class => '%s');
  52. EOF
  53.  
  54.   } elsif ($type eq 'passthrough') {
  55.     printf {$fh} <<'EOF', $subclass_dir, ref($build), ref($build);
  56.     
  57.     unless (eval "use Module::Build::Compat 0.02; 1" ) {
  58.       print "This module requires Module::Build to install itself.\n";
  59.       
  60.       require ExtUtils::MakeMaker;
  61.       my $yn = ExtUtils::MakeMaker::prompt
  62.     ('  Install Module::Build now from CPAN?', 'y');
  63.       
  64.       unless ($yn =~ /^y/i) {
  65.     die " *** Cannot install without Module::Build.  Exiting ...\n";
  66.       }
  67.       
  68.       require Cwd;
  69.       require File::Spec;
  70.       require CPAN;
  71.       
  72.       # Save this 'cause CPAN will chdir all over the place.
  73.       my $cwd = Cwd::cwd();
  74.       my $makefile = File::Spec->rel2abs($0);
  75.       
  76.       CPAN::Shell->install('Module::Build::Compat')
  77.     or die " *** Cannot install without Module::Build.  Exiting ...\n";
  78.       
  79.       chdir $cwd or die "Cannot chdir() back to $cwd: $!";
  80.     }
  81.     eval "use Module::Build::Compat 0.02; 1" or die $@;
  82.     use lib '%s';
  83.     Module::Build::Compat->run_build_pl(args => \@ARGV);
  84.     require %s;
  85.     Module::Build::Compat->write_makefile(build_class => '%s');
  86. EOF
  87.     
  88.   } elsif ($type eq 'traditional') {
  89.  
  90.     my (%MM_Args, %prereq);
  91.     if (eval "use Tie::IxHash; 1") {
  92.       tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
  93.       tie %prereq,  'Tie::IxHash'; # Don't care if it fails here
  94.     }
  95.     
  96.     my %name = ($build->module_name
  97.         ? (NAME => $build->module_name)
  98.         : (DISTNAME => $build->dist_name));
  99.     
  100.     my %version = ($build->dist_version_from
  101.            ? (VERSION_FROM => $build->dist_version_from)
  102.            : (VERSION      => $build->dist_version)
  103.           );
  104.     %MM_Args = (%name, %version);
  105.     
  106.     %prereq = ( %{$build->requires}, %{$build->build_requires} );
  107.     %prereq = map {$_, $prereq{$_}} sort keys %prereq;
  108.     
  109.     delete $prereq{perl};
  110.     $MM_Args{PREREQ_PM} = \%prereq;
  111.     
  112.     $MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs;
  113.     
  114.     $MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
  115.     
  116.     $MM_Args{PL_FILES} = {};
  117.     
  118.     local $Data::Dumper::Terse = 1;
  119.     my $args = Data::Dumper::Dumper(\%MM_Args);
  120.     $args =~ s/\{(.*)\}/($1)/s;
  121.     
  122.     print $fh <<"EOF";
  123. use ExtUtils::MakeMaker;
  124. WriteMakefile
  125. $args;
  126. EOF
  127.   }
  128. }
  129.  
  130.  
  131. sub makefile_to_build_args {
  132.   shift;
  133.   my @out;
  134.   foreach my $arg (@_) {
  135.     my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) :
  136.                die "Malformed argument '$arg'");
  137.  
  138.     # Do tilde-expansion if it looks like a tilde prefixed path
  139.     ( $val ) = glob( $val ) if $val =~ /^~/;
  140.  
  141.     if (exists $makefile_to_build{$key}) {
  142.       my $trans = $makefile_to_build{$key};
  143.       push @out, ref($trans) ? $trans->($val) : "$trans=$val";
  144.     } elsif (exists $Config{lc($key)}) {
  145.       push @out, 'config=' . lc($key) . "=$val";
  146.     } else {
  147.       # Assume M::B can handle it in lowercase form
  148.       push @out, "\L$key\E=$val";
  149.     }
  150.   }
  151.   return @out;
  152. }
  153.  
  154. sub makefile_to_build_macros {
  155.   my @out;
  156.   while (my ($macro, $trans) = each %makefile_to_build) {
  157.     # On some platforms (e.g. Cygwin with 'make'), the mere presence
  158.     # of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined.
  159.     # Therefore we check length() too.
  160.     next unless exists $ENV{$macro} && length $ENV{$macro};
  161.     my $val = $ENV{$macro};
  162.     push @out, ref($trans) ? $trans->($val) : ($trans => $val);
  163.   }
  164.   return @out;
  165. }
  166.  
  167. sub run_build_pl {
  168.   my ($pack, %in) = @_;
  169.   $in{script} ||= 'Build.PL';
  170.   my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : ();
  171.   print "# running $in{script} @args\n";
  172.   Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!";
  173. }
  174.  
  175. sub fake_makefile {
  176.   my ($self, %args) = @_;
  177.   unless (exists $args{build_class}) {
  178.     warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
  179.     $args{build_class} = 'Module::Build';
  180.   }
  181.  
  182.   my $perl = $args{build_class}->find_perl_interpreter;
  183.   my $os_type = $args{build_class}->os_type;
  184.   my $noop = ($os_type eq 'Windows' ? 'rem>nul' :
  185.           $os_type eq 'VMS'     ? 'Continue' :
  186.           'true');
  187.   my $Build = 'Build --makefile_env_macros 1';
  188.  
  189.   # Start with a couple special actions
  190.   my $maketext = <<"EOF";
  191. all : force_do_it
  192.     $perl $Build
  193. realclean : force_do_it
  194.     $perl $Build realclean
  195.     $perl -e unlink -e shift $args{makefile}
  196.  
  197. force_do_it :
  198.     @ $noop
  199. EOF
  200.  
  201.   foreach my $action ($args{build_class}->known_actions) {
  202.     next if $action =~ /^(all|realclean|force_do_it)$/;  # Don't double-define
  203.     $maketext .= <<"EOF";
  204. $action : force_do_it
  205.     $perl $Build $action
  206. EOF
  207.   }
  208.   
  209.   $maketext .= "\n.EXPORT : " . join(' ', keys %makefile_to_build) . "\n\n";
  210.   
  211.   return $maketext;
  212. }
  213.  
  214. sub fake_prereqs {
  215.   my $file = File::Spec->catfile('_build', 'prereqs');
  216.   my $fh = IO::File->new("< $file") or die "Can't read $file: $!";
  217.   my $prereqs = eval do {local $/; <$fh>};
  218.   close $fh;
  219.   
  220.   my @prereq;
  221.   foreach my $section (qw/build_requires requires/) {
  222.     foreach (keys %{$prereqs->{$section}}) {
  223.       next if $_ eq 'perl';
  224.       push @prereq, "$_=>q[$prereqs->{$section}{$_}]";
  225.     }
  226.   }
  227.  
  228.   return unless @prereq;
  229.   return "#     PREREQ_PM => { " . join(", ", @prereq) . " }\n\n";
  230. }
  231.  
  232.  
  233. sub write_makefile {
  234.   my ($pack, %in) = @_;
  235.   $in{makefile} ||= 'Makefile';
  236.   open  MAKE, "> $in{makefile}" or die "Cannot write $in{makefile}: $!";
  237.   print MAKE $pack->fake_prereqs;
  238.   print MAKE $pack->fake_makefile(%in);
  239.   close MAKE;
  240. }
  241.  
  242. 1;
  243. __END__
  244.  
  245.  
  246. =head1 NAME
  247.  
  248. Module::Build::Compat - Compatibility with ExtUtils::MakeMaker
  249.  
  250. =head1 SYNOPSIS
  251.  
  252.  # In a Build.PL :
  253.  use Module::Build;
  254.  my $build = Module::Build->new
  255.    ( module_name => 'Foo::Bar',
  256.      license => 'perl',
  257.      create_makefile_pl => 'passthrough' );
  258.  ...
  259.  
  260. =head1 DESCRIPTION
  261.  
  262. Because ExtUtils::MakeMaker has been the standard way to distribute
  263. modules for a long time, many tools (CPAN.pm, or your system
  264. administrator) may expect to find a working Makefile.PL in every
  265. distribution they download from CPAN.  If you want to throw them a
  266. bone, you can use Module::Build::Compat to automatically generate a
  267. Makefile.PL for you, in one of several different styles.
  268.  
  269. Module::Build::Compat also provides some code that helps out the
  270. Makefile.PL at runtime.
  271.  
  272. =head1 METHODS
  273.  
  274. =over 4
  275.  
  276. =item create_makefile_pl( $style, $build )
  277.  
  278. Creates a Makefile.PL in the current directory in one of several
  279. styles, based on the supplied Module::Build object C<$build>.  This is
  280. typically controlled by passing the desired style as the
  281. C<create_makefile_pl> parameter to Module::Build's C<new()> method;
  282. the Makefile.PL will then be automatically created during the
  283. C<distdir> action.
  284.  
  285. The currently supported styles are:
  286.  
  287. =over 4
  288.  
  289. =item small
  290.  
  291. A small Makefile.PL will be created that passes all functionality
  292. through to the Build.PL script in the same directory.  The user must
  293. already have Module::Build installed in order to use this, or else
  294. they'll get a module-not-found error.
  295.  
  296. =item passthrough
  297.  
  298. This is just like the C<small> option above, but if Module::Build is
  299. not already installed on the user's system, the script will offer to
  300. use C<CPAN.pm> to download it and install it before continuing with
  301. the build.
  302.  
  303. =item traditional
  304.  
  305. A Makefile.PL will be created in the "traditional" style, i.e. it will
  306. use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all.
  307. In order to create the Makefile.PL, we'll include the C<requires> and
  308. C<build_requires> dependencies as the C<PREREQ_PM> parameter.
  309.  
  310. You don't want to use this style if during the C<perl Build.PL> stage
  311. you ask the user questions, or do some auto-sensing about the user's
  312. environment, or if you subclass Module::Build to do some
  313. customization, because the vanilla Makefile.PL won't do any of that.
  314.  
  315. =back
  316.  
  317. =item run_build_pl( args => \@ARGV )
  318.  
  319. This method runs the Build.PL script, passing it any arguments the
  320. user may have supplied to the C<perl Makefile.PL> command.  Because
  321. ExtUtils::MakeMaker and Module::Build accept different arguments, this
  322. method also performs some translation between the two.
  323.  
  324. C<run_build_pl()> accepts the following named parameters:
  325.  
  326. =over 4
  327.  
  328. =item args
  329.  
  330. The C<args> parameter specifies the parameters that would usually
  331. appear on the command line of the C<perl Makefile.PL> command -
  332. typically you'll just pass a reference to C<@ARGV>.
  333.  
  334. =item script
  335.  
  336. This is the filename of the script to run - it defaults to C<Build.PL>.
  337.  
  338. =back
  339.  
  340.  
  341. =item write_makefile()
  342.  
  343. This method writes a 'dummy' Makefile that will pass all commands
  344. through to the corresponding Module::Build actions.
  345.  
  346. C<write_makefile()> accepts the following named parameters:
  347.  
  348. =over 4
  349.  
  350. =item makefile
  351.  
  352. The name of the file to write - defaults to the string C<Makefile>.
  353.  
  354. =back
  355.  
  356. =back
  357.  
  358. =head1 SCENARIOS
  359.  
  360. So, some common scenarios are:
  361.  
  362. =over 4
  363.  
  364. =item 1.
  365.  
  366. Just include a Build.PL script (without a Makefile.PL
  367. script), and give installation directions in a README or INSTALL
  368. document explaining how to install the module.  In particular, explain
  369. that the user must install Module::Build before installing your
  370. module.  
  371.  
  372. Note that if you do this, you may make things easier for yourself, but
  373. harder for people with older versions of CPAN or CPANPLUS on their
  374. system, because those tools generally only understand the
  375. F<Makefile.PL>/C<ExtUtils::MakeMaker> way of doing things.
  376.  
  377. =item 2.
  378.  
  379. Include a Build.PL script and a "traditional" Makefile.PL,
  380. created either manually or with C<create_makefile_pl()>.  Users won't
  381. ever have to install Module::Build if they use the Makefile.PL, but
  382. they won't get to take advantage of Module::Build's extra features
  383. either.
  384.  
  385. If you go this route, make sure you explicitly set C<PL_FILES> in the
  386. call to C<WriteMakefile()> (probably to an empty hash reference), or
  387. else MakeMaker will mistakenly run the Build.PL and you'll get an
  388. error message about "Too early to run Build script" or something.  For
  389. good measure, of course, test both the F<Makefile.PL> and the
  390. F<Build.PL> before shipping.
  391.  
  392. =item 3.
  393.  
  394. Include a Build.PL script and a "pass-through" Makefile.PL
  395. built using Module::Build::Compat.  This will mean that people can
  396. continue to use the "old" installation commands, and they may never
  397. notice that it's actually doing something else behind the scenes.  It
  398. will also mean that your installation process is compatible with older
  399. versions of tools like CPAN and CPANPLUS.
  400.  
  401. =back
  402.  
  403. =head1 AUTHOR
  404.  
  405. Ken Williams, ken@mathforum.org
  406.  
  407. =head1 SEE ALSO
  408.  
  409. Module::Build(3), ExtUtils::MakeMaker(3)
  410.  
  411. =cut
  412.