Imported Upstream version 1.12
This commit is contained in:
Mario Fetka
1927
inc/Module-Build/Module/Build/API.pod
Normal file
1927
inc/Module-Build/Module/Build/API.pod
Normal file
File diff suppressed because it is too large
Load Diff
323
inc/Module-Build/Module/Build/Authoring.pod
Normal file
323
inc/Module-Build/Module/Build/Authoring.pod
Normal file
@@ -0,0 +1,323 @@
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Authoring - Authoring Module::Build modules
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
When creating a C<Build.PL> script for a module, something like the
|
||||
following code will typically be used:
|
||||
|
||||
use Module::Build;
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
requires => {
|
||||
'perl' => '5.6.1',
|
||||
'Some::Module' => '1.23',
|
||||
'Other::Module' => '>= 1.2, != 1.5, < 2.0',
|
||||
},
|
||||
);
|
||||
$build->create_build_script;
|
||||
|
||||
A simple module could get away with something as short as this for its
|
||||
C<Build.PL> script:
|
||||
|
||||
use Module::Build;
|
||||
Module::Build->new(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
)->create_build_script;
|
||||
|
||||
The model used by C<Module::Build> is a lot like the C<MakeMaker>
|
||||
metaphor, with the following correspondences:
|
||||
|
||||
In Module::Build In ExtUtils::MakeMaker
|
||||
--------------------------- ------------------------
|
||||
Build.PL (initial script) Makefile.PL (initial script)
|
||||
Build (a short perl script) Makefile (a long Makefile)
|
||||
_build/ (saved state info) various config text in the Makefile
|
||||
|
||||
Any customization can be done simply by subclassing C<Module::Build>
|
||||
and adding a method called (for example) C<ACTION_test>, overriding
|
||||
the default 'test' action. You could also add a method called
|
||||
C<ACTION_whatever>, and then you could perform the action C<Build
|
||||
whatever>.
|
||||
|
||||
For information on providing compatibility with
|
||||
C<ExtUtils::MakeMaker>, see L<Module::Build::Compat> and
|
||||
L<http://www.makemaker.org/wiki/index.cgi?ModuleBuildConversionGuide>.
|
||||
|
||||
|
||||
=head1 STRUCTURE
|
||||
|
||||
Module::Build creates a class hierarchy conducive to customization.
|
||||
Here is the parent-child class hierarchy in classy ASCII art:
|
||||
|
||||
/--------------------\
|
||||
| Your::Parent | (If you subclass Module::Build)
|
||||
\--------------------/
|
||||
|
|
||||
|
|
||||
/--------------------\ (Doesn't define any functionality
|
||||
| Module::Build | of its own - just figures out what
|
||||
\--------------------/ other modules to load.)
|
||||
|
|
||||
|
|
||||
/-----------------------------------\ (Some values of $^O may
|
||||
| Module::Build::Platform::$^O | define specialized functionality.
|
||||
\-----------------------------------/ Otherwise it's ...::Default, a
|
||||
| pass-through class.)
|
||||
|
|
||||
/--------------------------\
|
||||
| Module::Build::Base | (Most of the functionality of
|
||||
\--------------------------/ Module::Build is defined here.)
|
||||
|
||||
|
||||
=head1 SUBCLASSING
|
||||
|
||||
Right now, there are two ways to subclass Module::Build. The first
|
||||
way is to create a regular module (in a C<.pm> file) that inherits
|
||||
from Module::Build, and use that module's class instead of using
|
||||
Module::Build directly:
|
||||
|
||||
------ in Build.PL: ----------
|
||||
#!/usr/bin/perl
|
||||
|
||||
use lib q(/nonstandard/library/path);
|
||||
use My::Builder; # Or whatever you want to call it
|
||||
|
||||
my $build = My::Builder->new
|
||||
(
|
||||
module_name => 'Foo::Bar', # All the regular args...
|
||||
license => 'perl',
|
||||
dist_author => 'A N Other <me@here.net.au>',
|
||||
requires => { Carp => 0 }
|
||||
);
|
||||
$build->create_build_script;
|
||||
|
||||
This is relatively straightforward, and is the best way to do things
|
||||
if your My::Builder class contains lots of code. The
|
||||
C<create_build_script()> method will ensure that the current value of
|
||||
C<@INC> (including the C</nonstandard/library/path>) is propagated to
|
||||
the Build script, so that My::Builder can be found when running build
|
||||
actions. If you find that you need to C<chdir> into a different directories
|
||||
in your subclass methods or actions, be sure to always return to the original
|
||||
directory (available via the C<base_dir()> method before returning control
|
||||
to the parent class. This is important to avoid data serialization problems.
|
||||
|
||||
For very small additions, Module::Build provides a C<subclass()>
|
||||
method that lets you subclass Module::Build more conveniently, without
|
||||
creating a separate file for your module:
|
||||
|
||||
------ in Build.PL: ----------
|
||||
#!/usr/bin/perl
|
||||
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass
|
||||
(
|
||||
class => 'My::Builder',
|
||||
code => q{
|
||||
sub ACTION_foo {
|
||||
print "I'm fooing to death!\n";
|
||||
}
|
||||
},
|
||||
);
|
||||
|
||||
my $build = $class->new
|
||||
(
|
||||
module_name => 'Foo::Bar', # All the regular args...
|
||||
license => 'perl',
|
||||
dist_author => 'A N Other <me@here.net.au>',
|
||||
requires => { Carp => 0 }
|
||||
);
|
||||
$build->create_build_script;
|
||||
|
||||
Behind the scenes, this actually does create a C<.pm> file, since the
|
||||
code you provide must persist after Build.PL is run if it is to be
|
||||
very useful.
|
||||
|
||||
See also the documentation for the L<Module::Build::API/"subclass()">
|
||||
method.
|
||||
|
||||
|
||||
=head1 PREREQUISITES
|
||||
|
||||
=head2 Types of prerequisites
|
||||
|
||||
To specify what versions of other modules are used by this
|
||||
distribution, several types of prerequisites can be defined with the
|
||||
following parameters:
|
||||
|
||||
=over 3
|
||||
|
||||
=item configure_requires
|
||||
|
||||
Items that must be installed I<before> configuring this distribution
|
||||
(i.e. before running the F<Build.PL> script). This might be a
|
||||
specific minimum version of C<Module::Build> or any other module the
|
||||
F<Build.PL> needs in order to do its stuff. Clients like C<CPAN.pm>
|
||||
or C<CPANPLUS> will be expected to pick C<configure_requires> out of the
|
||||
F<META.yml> file and install these items before running the
|
||||
C<Build.PL>.
|
||||
|
||||
If no configure_requires is specified, the current version of Module::Build
|
||||
is automatically added to configure_requires.
|
||||
|
||||
=item build_requires
|
||||
|
||||
Items that are necessary for building and testing this distribution,
|
||||
but aren't necessary after installation. This can help users who only
|
||||
want to install these items temporarily. It also helps reduce the
|
||||
size of the CPAN dependency graph if everything isn't smooshed into
|
||||
C<requires>.
|
||||
|
||||
=item requires
|
||||
|
||||
Items that are necessary for basic functioning.
|
||||
|
||||
=item recommends
|
||||
|
||||
Items that are recommended for enhanced functionality, but there are
|
||||
ways to use this distribution without having them installed. You
|
||||
might also think of this as "can use" or "is aware of" or "changes
|
||||
behavior in the presence of".
|
||||
|
||||
=item conflicts
|
||||
|
||||
Items that can cause problems with this distribution when installed.
|
||||
This is pretty rare.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Format of prerequisites
|
||||
|
||||
The prerequisites are given in a hash reference, where the keys are
|
||||
the module names and the values are version specifiers:
|
||||
|
||||
requires => {
|
||||
Foo::Module => '2.4',
|
||||
Bar::Module => 0,
|
||||
Ken::Module => '>= 1.2, != 1.5, < 2.0',
|
||||
perl => '5.6.0'
|
||||
},
|
||||
|
||||
The above four version specifiers have different effects. The value
|
||||
C<'2.4'> means that B<at least> version 2.4 of C<Foo::Module> must be
|
||||
installed. The value C<0> means that B<any> version of C<Bar::Module>
|
||||
is acceptable, even if C<Bar::Module> doesn't define a version. The
|
||||
more verbose value C<'E<gt>= 1.2, != 1.5, E<lt> 2.0'> means that
|
||||
C<Ken::Module>'s version must be B<at least> 1.2, B<less than> 2.0,
|
||||
and B<not equal to> 1.5. The list of criteria is separated by commas,
|
||||
and all criteria must be satisfied.
|
||||
|
||||
A special C<perl> entry lets you specify the versions of the Perl
|
||||
interpreter that are supported by your module. The same version
|
||||
dependency-checking semantics are available, except that we also
|
||||
understand perl's new double-dotted version numbers.
|
||||
|
||||
=head2 XS Extensions
|
||||
|
||||
Modules which need to compile XS code should list C<ExtUtils::CBuilder>
|
||||
as a C<build_requires> element.
|
||||
|
||||
|
||||
=head1 SAVING CONFIGURATION INFORMATION
|
||||
|
||||
Module::Build provides a very convenient way to save configuration
|
||||
information that your installed modules (or your regression tests) can
|
||||
access. If your Build process calls the C<feature()> or
|
||||
C<config_data()> methods, then a C<Foo::Bar::ConfigData> module will
|
||||
automatically be created for you, where C<Foo::Bar> is the
|
||||
C<module_name> parameter as passed to C<new()>. This module provides
|
||||
access to the data saved by these methods, and a way to update the
|
||||
values. There is also a utility script called C<config_data>
|
||||
distributed with Module::Build that provides a command line interface
|
||||
to this same functionality. See also the generated
|
||||
C<Foo::Bar::ConfigData> documentation, and the C<config_data>
|
||||
script's documentation, for more information.
|
||||
|
||||
|
||||
=head1 STARTING MODULE DEVELOPMENT
|
||||
|
||||
When starting development on a new module, it's rarely worth your time
|
||||
to create a tree of all the files by hand. Some automatic
|
||||
module-creators are available: the oldest is C<h2xs>, which has
|
||||
shipped with perl itself for a long time. Its name reflects the fact
|
||||
that modules were originally conceived of as a way to wrap up a C
|
||||
library (thus the C<h> part) into perl extensions (thus the C<xs>
|
||||
part).
|
||||
|
||||
These days, C<h2xs> has largely been superseded by modules like
|
||||
C<ExtUtils::ModuleMaker>, and C<Module::Starter>. They have varying
|
||||
degrees of support for C<Module::Build>.
|
||||
|
||||
|
||||
=head1 AUTOMATION
|
||||
|
||||
One advantage of Module::Build is that since it's implemented as Perl
|
||||
methods, you can invoke these methods directly if you want to install
|
||||
a module non-interactively. For instance, the following Perl script
|
||||
will invoke the entire build/install procedure:
|
||||
|
||||
my $build = Module::Build->new(module_name => 'MyModule');
|
||||
$build->dispatch('build');
|
||||
$build->dispatch('test');
|
||||
$build->dispatch('install');
|
||||
|
||||
If any of these steps encounters an error, it will throw a fatal
|
||||
exception.
|
||||
|
||||
You can also pass arguments as part of the build process:
|
||||
|
||||
my $build = Module::Build->new(module_name => 'MyModule');
|
||||
$build->dispatch('build');
|
||||
$build->dispatch('test', verbose => 1);
|
||||
$build->dispatch('install', sitelib => '/my/secret/place/');
|
||||
|
||||
Building and installing modules in this way skips creating the
|
||||
C<Build> script.
|
||||
|
||||
|
||||
=head1 MIGRATION
|
||||
|
||||
Note that if you want to provide both a F<Makefile.PL> and a
|
||||
F<Build.PL> for your distribution, you probably want to add the
|
||||
following to C<WriteMakefile> in your F<Makefile.PL> so that C<MakeMaker>
|
||||
doesn't try to run your F<Build.PL> as a normal F<.PL> file:
|
||||
|
||||
PL_FILES => {},
|
||||
|
||||
You may also be interested in looking at the C<Module::Build::Compat>
|
||||
module, which can automatically create various kinds of F<Makefile.PL>
|
||||
compatibility layers.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
Development questions, bug reports, and patches should be sent to the
|
||||
Module-Build mailing list at <module-build@perl.org>.
|
||||
|
||||
Bug reports are also welcome at
|
||||
<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>.
|
||||
|
||||
The latest development version is available from the Subversion
|
||||
repository at <https://svn.perl.org/modules/Module-Build/trunk/>
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), L<Module::Build>(3), L<Module::Build::API>(3),
|
||||
L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3), L<YAML>(3)
|
||||
|
||||
F<META.yml> Specification:
|
||||
L<http://module-build.sourceforge.net/META-spec-current.html>
|
||||
|
||||
L<http://www.dsmit.com/cons/>
|
||||
|
||||
L<http://search.cpan.org/dist/PerlBuildSystem/>
|
||||
|
||||
=cut
|
||||
4653
inc/Module-Build/Module/Build/Base.pm
Normal file
4653
inc/Module-Build/Module/Build/Base.pm
Normal file
File diff suppressed because it is too large
Load Diff
578
inc/Module-Build/Module/Build/Compat.pm
Normal file
578
inc/Module-Build/Module/Build/Compat.pm
Normal file
@@ -0,0 +1,578 @@
|
||||
package Module::Build::Compat;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
|
||||
use File::Basename ();
|
||||
use File::Spec;
|
||||
use IO::File;
|
||||
use Config;
|
||||
use Module::Build;
|
||||
use Module::Build::ModuleInfo;
|
||||
use Data::Dumper;
|
||||
|
||||
my %convert_installdirs = (
|
||||
PERL => 'core',
|
||||
SITE => 'site',
|
||||
VENDOR => 'vendor',
|
||||
);
|
||||
|
||||
my %makefile_to_build =
|
||||
(
|
||||
TEST_VERBOSE => 'verbose',
|
||||
VERBINST => 'verbose',
|
||||
INC => sub { map {(extra_compiler_flags => $_)} Module::Build->split_like_shell(shift) },
|
||||
POLLUTE => sub { (extra_compiler_flags => '-DPERL_POLLUTE') },
|
||||
INSTALLDIRS => sub { (installdirs => $convert_installdirs{uc shift()}) },
|
||||
LIB => sub {
|
||||
my $lib = shift;
|
||||
my %config = (
|
||||
installprivlib => $lib,
|
||||
installsitelib => $lib,
|
||||
installarchlib => "$lib/$Config{archname}",
|
||||
installsitearch => "$lib/$Config{archname}"
|
||||
);
|
||||
return map { (config => "$_=$config{$_}") } keys %config;
|
||||
},
|
||||
|
||||
# Convert INSTALLVENDORLIB and friends.
|
||||
(
|
||||
map {
|
||||
my $name = $_;
|
||||
$name => sub {
|
||||
my @ret = (config => lc($name) . "=" . shift );
|
||||
print STDERR "# Converted to @ret\n";
|
||||
|
||||
return @ret;
|
||||
}
|
||||
} qw(
|
||||
INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH
|
||||
INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB
|
||||
INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN
|
||||
INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT
|
||||
INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
|
||||
INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
|
||||
)
|
||||
),
|
||||
|
||||
# Some names they have in common
|
||||
map {$_, lc($_)} qw(DESTDIR PREFIX INSTALL_BASE UNINST),
|
||||
);
|
||||
|
||||
my %macro_to_build = %makefile_to_build;
|
||||
# "LIB=foo make" is not the same as "perl Makefile.PL LIB=foo"
|
||||
delete $macro_to_build{LIB};
|
||||
|
||||
|
||||
sub create_makefile_pl {
|
||||
my ($package, $type, $build, %args) = @_;
|
||||
|
||||
die "Don't know how to build Makefile.PL of type '$type'"
|
||||
unless $type =~ /^(small|passthrough|traditional)$/;
|
||||
|
||||
my $fh;
|
||||
if ($args{fh}) {
|
||||
$fh = $args{fh};
|
||||
} else {
|
||||
$args{file} ||= 'Makefile.PL';
|
||||
local $build->{properties}{quiet} = 1;
|
||||
$build->delete_filetree($args{file});
|
||||
$fh = IO::File->new("> $args{file}") or die "Can't write $args{file}: $!";
|
||||
}
|
||||
|
||||
print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";
|
||||
|
||||
# Minimum perl version should be specified as "require 5.XXXXXX" in
|
||||
# Makefile.PL
|
||||
my $requires = $build->requires;
|
||||
if ( my $minimum_perl = $requires->{perl} ) {
|
||||
print {$fh} "require $minimum_perl;\n";
|
||||
}
|
||||
|
||||
# If a *bundled* custom subclass is being used, make sure we add its
|
||||
# directory to @INC. Also, lib.pm always needs paths in Unix format.
|
||||
my $subclass_load = '';
|
||||
if (ref($build) ne "Module::Build") {
|
||||
my $subclass_dir = $package->subclass_dir($build);
|
||||
|
||||
if (File::Spec->file_name_is_absolute($subclass_dir)) {
|
||||
my $base_dir = $build->base_dir;
|
||||
|
||||
if ($build->dir_contains($base_dir, $subclass_dir)) {
|
||||
$subclass_dir = File::Spec->abs2rel($subclass_dir, $base_dir);
|
||||
$subclass_dir = $package->unixify_dir($subclass_dir);
|
||||
$subclass_load = "use lib '$subclass_dir';";
|
||||
}
|
||||
# Otherwise, leave it the empty string
|
||||
|
||||
} else {
|
||||
$subclass_dir = $package->unixify_dir($subclass_dir);
|
||||
$subclass_load = "use lib '$subclass_dir';";
|
||||
}
|
||||
}
|
||||
|
||||
if ($type eq 'small') {
|
||||
printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
|
||||
use Module::Build::Compat 0.02;
|
||||
%s
|
||||
Module::Build::Compat->run_build_pl(args => \@ARGV);
|
||||
require %s;
|
||||
Module::Build::Compat->write_makefile(build_class => '%s');
|
||||
EOF
|
||||
|
||||
} elsif ($type eq 'passthrough') {
|
||||
printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
|
||||
|
||||
unless (eval "use Module::Build::Compat 0.02; 1" ) {
|
||||
print "This module requires Module::Build to install itself.\n";
|
||||
|
||||
require ExtUtils::MakeMaker;
|
||||
my $yn = ExtUtils::MakeMaker::prompt
|
||||
(' Install Module::Build now from CPAN?', 'y');
|
||||
|
||||
unless ($yn =~ /^y/i) {
|
||||
die " *** Cannot install without Module::Build. Exiting ...\n";
|
||||
}
|
||||
|
||||
require Cwd;
|
||||
require File::Spec;
|
||||
require CPAN;
|
||||
|
||||
# Save this 'cause CPAN will chdir all over the place.
|
||||
my $cwd = Cwd::cwd();
|
||||
|
||||
CPAN::Shell->install('Module::Build::Compat');
|
||||
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
|
||||
or die "Couldn't install Module::Build, giving up.\n";
|
||||
|
||||
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
|
||||
}
|
||||
eval "use Module::Build::Compat 0.02; 1" or die $@;
|
||||
%s
|
||||
Module::Build::Compat->run_build_pl(args => \@ARGV);
|
||||
my $build_script = 'Build';
|
||||
$build_script .= '.com' if $^O eq 'VMS';
|
||||
exit(0) unless(-e $build_script); # cpantesters convention
|
||||
require %s;
|
||||
Module::Build::Compat->write_makefile(build_class => '%s');
|
||||
EOF
|
||||
|
||||
} elsif ($type eq 'traditional') {
|
||||
|
||||
my (%MM_Args, %prereq);
|
||||
if (eval "use Tie::IxHash; 1") {
|
||||
tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
|
||||
tie %prereq, 'Tie::IxHash'; # Don't care if it fails here
|
||||
}
|
||||
|
||||
my %name = ($build->module_name
|
||||
? (NAME => $build->module_name)
|
||||
: (DISTNAME => $build->dist_name));
|
||||
|
||||
my %version = ($build->dist_version_from
|
||||
? (VERSION_FROM => $build->dist_version_from)
|
||||
: (VERSION => $build->dist_version)
|
||||
);
|
||||
%MM_Args = (%name, %version);
|
||||
|
||||
%prereq = ( %{$build->requires}, %{$build->build_requires} );
|
||||
%prereq = map {$_, $prereq{$_}} sort keys %prereq;
|
||||
|
||||
delete $prereq{perl};
|
||||
$MM_Args{PREREQ_PM} = \%prereq;
|
||||
|
||||
$MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs;
|
||||
|
||||
$MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
|
||||
|
||||
$MM_Args{PL_FILES} = $build->PL_files || {};
|
||||
|
||||
if ($build->recursive_test_files) {
|
||||
$MM_Args{TESTS} = join q{ }, $package->_test_globs($build);
|
||||
}
|
||||
|
||||
local $Data::Dumper::Terse = 1;
|
||||
my $args = Data::Dumper::Dumper(\%MM_Args);
|
||||
$args =~ s/\{(.*)\}/($1)/s;
|
||||
|
||||
print $fh <<"EOF";
|
||||
use ExtUtils::MakeMaker;
|
||||
WriteMakefile
|
||||
$args;
|
||||
EOF
|
||||
}
|
||||
}
|
||||
|
||||
sub _test_globs {
|
||||
my ($self, $build) = @_;
|
||||
|
||||
return map { File::Spec->catfile($_, '*.t') }
|
||||
@{$build->rscan_dir('t', sub { -d $File::Find::name })};
|
||||
}
|
||||
|
||||
sub subclass_dir {
|
||||
my ($self, $build) = @_;
|
||||
|
||||
return (Module::Build::ModuleInfo->find_module_dir_by_name(ref $build)
|
||||
|| File::Spec->catdir($build->config_dir, 'lib'));
|
||||
}
|
||||
|
||||
sub unixify_dir {
|
||||
my ($self, $path) = @_;
|
||||
return join '/', File::Spec->splitdir($path);
|
||||
}
|
||||
|
||||
sub makefile_to_build_args {
|
||||
my $class = shift;
|
||||
my @out;
|
||||
foreach my $arg (@_) {
|
||||
next if $arg eq '';
|
||||
|
||||
my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) :
|
||||
die "Malformed argument '$arg'");
|
||||
|
||||
# Do tilde-expansion if it looks like a tilde prefixed path
|
||||
( $val ) = Module::Build->_detildefy( $val ) if $val =~ /^~/;
|
||||
|
||||
if (exists $makefile_to_build{$key}) {
|
||||
my $trans = $makefile_to_build{$key};
|
||||
push @out, $class->_argvify( ref($trans) ? $trans->($val) : ($trans => $val) );
|
||||
} elsif (exists $Config{lc($key)}) {
|
||||
push @out, $class->_argvify( config => lc($key) . "=$val" );
|
||||
} else {
|
||||
# Assume M::B can handle it in lowercase form
|
||||
push @out, $class->_argvify("\L$key" => $val);
|
||||
}
|
||||
}
|
||||
return @out;
|
||||
}
|
||||
|
||||
sub _argvify {
|
||||
my ($self, @pairs) = @_;
|
||||
my @out;
|
||||
while (@pairs) {
|
||||
my ($k, $v) = splice @pairs, 0, 2;
|
||||
push @out, ("--$k", $v);
|
||||
}
|
||||
return @out;
|
||||
}
|
||||
|
||||
sub makefile_to_build_macros {
|
||||
my @out;
|
||||
my %config; # must accumulate and return as a hashref
|
||||
while (my ($macro, $trans) = each %macro_to_build) {
|
||||
# On some platforms (e.g. Cygwin with 'make'), the mere presence
|
||||
# of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined.
|
||||
# Therefore we check length() too.
|
||||
next unless exists $ENV{$macro} && length $ENV{$macro};
|
||||
my $val = $ENV{$macro};
|
||||
my @args = ref($trans) ? $trans->($val) : ($trans => $val);
|
||||
while (@args) {
|
||||
my ($k, $v) = splice(@args, 0, 2);
|
||||
if ( $k eq 'config' ) {
|
||||
if ( $v =~ /^([^=]+)=(.*)$/ ) {
|
||||
$config{$1} = $2;
|
||||
}
|
||||
else {
|
||||
warn "Couldn't parse config '$v'\n";
|
||||
}
|
||||
}
|
||||
else {
|
||||
push @out, ($k => $v);
|
||||
}
|
||||
}
|
||||
}
|
||||
push @out, (config => \%config) if %config;
|
||||
return @out;
|
||||
}
|
||||
|
||||
sub run_build_pl {
|
||||
my ($pack, %in) = @_;
|
||||
$in{script} ||= 'Build.PL';
|
||||
my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : ();
|
||||
print "# running $in{script} @args\n";
|
||||
Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!";
|
||||
}
|
||||
|
||||
sub fake_makefile {
|
||||
my ($self, %args) = @_;
|
||||
unless (exists $args{build_class}) {
|
||||
warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
|
||||
$args{build_class} = 'Module::Build';
|
||||
}
|
||||
my $class = $args{build_class};
|
||||
|
||||
my $perl = $class->find_perl_interpreter;
|
||||
|
||||
# VMS MMS/MMK need to use MCR to run the Perl image.
|
||||
$perl = 'MCR ' . $perl if $self->_is_vms_mms;
|
||||
|
||||
my $noop = ($class->is_windowsish ? 'rem>nul' :
|
||||
$self->_is_vms_mms ? 'Continue' :
|
||||
'true');
|
||||
|
||||
my $filetype = $class->is_vmsish ? '.COM' : '';
|
||||
|
||||
my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
|
||||
my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
|
||||
$unlink =~ s/\$/\$\$/g unless $class->is_vmsish;
|
||||
|
||||
my $maketext = <<"EOF";
|
||||
all : force_do_it
|
||||
$perl $Build
|
||||
realclean : force_do_it
|
||||
$perl $Build realclean
|
||||
$unlink
|
||||
distclean : force_do_it
|
||||
$perl $Build distclean
|
||||
$unlink
|
||||
|
||||
|
||||
force_do_it :
|
||||
@ $noop
|
||||
EOF
|
||||
|
||||
foreach my $action ($class->known_actions) {
|
||||
next if $action =~ /^(all|distclean|realclean|force_do_it)$/; # Don't double-define
|
||||
$maketext .= <<"EOF";
|
||||
$action : force_do_it
|
||||
$perl $Build $action
|
||||
EOF
|
||||
}
|
||||
|
||||
if ($self->_is_vms_mms) {
|
||||
# Roll our own .EXPORT as MMS/MMK don't honor that directive.
|
||||
$maketext .= "\n.FIRST\n\t\@ $noop\n";
|
||||
for my $macro (keys %macro_to_build) {
|
||||
$maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n";
|
||||
}
|
||||
$maketext .= "\n";
|
||||
}
|
||||
else {
|
||||
$maketext .= "\n.EXPORT : " . join(' ', keys %macro_to_build) . "\n\n";
|
||||
}
|
||||
|
||||
return $maketext;
|
||||
}
|
||||
|
||||
sub fake_prereqs {
|
||||
my $file = File::Spec->catfile('_build', 'prereqs');
|
||||
my $fh = IO::File->new("< $file") or die "Can't read $file: $!";
|
||||
my $prereqs = eval do {local $/; <$fh>};
|
||||
close $fh;
|
||||
|
||||
my @prereq;
|
||||
foreach my $section (qw/build_requires requires/) {
|
||||
foreach (keys %{$prereqs->{$section}}) {
|
||||
next if $_ eq 'perl';
|
||||
push @prereq, "$_=>q[$prereqs->{$section}{$_}]";
|
||||
}
|
||||
}
|
||||
|
||||
return unless @prereq;
|
||||
return "# PREREQ_PM => { " . join(", ", @prereq) . " }\n\n";
|
||||
}
|
||||
|
||||
|
||||
sub write_makefile {
|
||||
my ($pack, %in) = @_;
|
||||
|
||||
unless (exists $in{build_class}) {
|
||||
warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
|
||||
$in{build_class} = 'Module::Build';
|
||||
}
|
||||
my $class = $in{build_class};
|
||||
$in{makefile} ||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile';
|
||||
|
||||
open MAKE, "> $in{makefile}" or die "Cannot write $in{makefile}: $!";
|
||||
print MAKE $pack->fake_prereqs;
|
||||
print MAKE $pack->fake_makefile(%in);
|
||||
close MAKE;
|
||||
}
|
||||
|
||||
sub _is_vms_mms {
|
||||
return Module::Build->is_vmsish && ($Config{make} =~ m/MM[SK]/i);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=for :stopwords passthrough
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Compat - Compatibility with ExtUtils::MakeMaker
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# In a Build.PL :
|
||||
use Module::Build;
|
||||
my $build = Module::Build->new
|
||||
( module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
create_makefile_pl => 'passthrough' );
|
||||
...
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Because C<ExtUtils::MakeMaker> has been the standard way to distribute
|
||||
modules for a long time, many tools (CPAN.pm, or your system
|
||||
administrator) may expect to find a working F<Makefile.PL> in every
|
||||
distribution they download from CPAN. If you want to throw them a
|
||||
bone, you can use C<Module::Build::Compat> to automatically generate a
|
||||
F<Makefile.PL> for you, in one of several different styles.
|
||||
|
||||
C<Module::Build::Compat> also provides some code that helps out the
|
||||
F<Makefile.PL> at runtime.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item create_makefile_pl($style, $build)
|
||||
|
||||
Creates a F<Makefile.PL> in the current directory in one of several
|
||||
styles, based on the supplied C<Module::Build> object C<$build>. This is
|
||||
typically controlled by passing the desired style as the
|
||||
C<create_makefile_pl> parameter to C<Module::Build>'s C<new()> method;
|
||||
the F<Makefile.PL> will then be automatically created during the
|
||||
C<distdir> action.
|
||||
|
||||
The currently supported styles are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item small
|
||||
|
||||
A small F<Makefile.PL> will be created that passes all functionality
|
||||
through to the F<Build.PL> script in the same directory. The user must
|
||||
already have C<Module::Build> installed in order to use this, or else
|
||||
they'll get a module-not-found error.
|
||||
|
||||
=item passthrough
|
||||
|
||||
This is just like the C<small> option above, but if C<Module::Build> is
|
||||
not already installed on the user's system, the script will offer to
|
||||
use C<CPAN.pm> to download it and install it before continuing with
|
||||
the build.
|
||||
|
||||
=item traditional
|
||||
|
||||
A F<Makefile.PL> will be created in the "traditional" style, i.e. it will
|
||||
use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all.
|
||||
In order to create the F<Makefile.PL>, we'll include the C<requires> and
|
||||
C<build_requires> dependencies as the C<PREREQ_PM> parameter.
|
||||
|
||||
You don't want to use this style if during the C<perl Build.PL> stage
|
||||
you ask the user questions, or do some auto-sensing about the user's
|
||||
environment, or if you subclass C<Module::Build> to do some
|
||||
customization, because the vanilla F<Makefile.PL> won't do any of that.
|
||||
|
||||
=back
|
||||
|
||||
=item run_build_pl(args => \@ARGV)
|
||||
|
||||
This method runs the F<Build.PL> script, passing it any arguments the
|
||||
user may have supplied to the C<perl Makefile.PL> command. Because
|
||||
C<ExtUtils::MakeMaker> and C<Module::Build> accept different arguments, this
|
||||
method also performs some translation between the two.
|
||||
|
||||
C<run_build_pl()> accepts the following named parameters:
|
||||
|
||||
=over 4
|
||||
|
||||
=item args
|
||||
|
||||
The C<args> parameter specifies the parameters that would usually
|
||||
appear on the command line of the C<perl Makefile.PL> command -
|
||||
typically you'll just pass a reference to C<@ARGV>.
|
||||
|
||||
=item script
|
||||
|
||||
This is the filename of the script to run - it defaults to C<Build.PL>.
|
||||
|
||||
=back
|
||||
|
||||
=item write_makefile()
|
||||
|
||||
This method writes a 'dummy' F<Makefile> that will pass all commands
|
||||
through to the corresponding C<Module::Build> actions.
|
||||
|
||||
C<write_makefile()> accepts the following named parameters:
|
||||
|
||||
=over 4
|
||||
|
||||
=item makefile
|
||||
|
||||
The name of the file to write - defaults to the string C<Makefile>.
|
||||
|
||||
=back
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 SCENARIOS
|
||||
|
||||
So, some common scenarios are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item 1.
|
||||
|
||||
Just include a F<Build.PL> script (without a F<Makefile.PL>
|
||||
script), and give installation directions in a F<README> or F<INSTALL>
|
||||
document explaining how to install the module. In particular, explain
|
||||
that the user must install C<Module::Build> before installing your
|
||||
module.
|
||||
|
||||
Note that if you do this, you may make things easier for yourself, but
|
||||
harder for people with older versions of CPAN or CPANPLUS on their
|
||||
system, because those tools generally only understand the
|
||||
F<Makefile.PL>/C<ExtUtils::MakeMaker> way of doing things.
|
||||
|
||||
=item 2.
|
||||
|
||||
Include a F<Build.PL> script and a "traditional" F<Makefile.PL>,
|
||||
created either manually or with C<create_makefile_pl()>. Users won't
|
||||
ever have to install C<Module::Build> if they use the F<Makefile.PL>, but
|
||||
they won't get to take advantage of C<Module::Build>'s extra features
|
||||
either.
|
||||
|
||||
For good measure, of course, test both the F<Makefile.PL> and the
|
||||
F<Build.PL> before shipping.
|
||||
|
||||
=item 3.
|
||||
|
||||
Include a F<Build.PL> script and a "pass-through" F<Makefile.PL>
|
||||
built using C<Module::Build::Compat>. This will mean that people can
|
||||
continue to use the "old" installation commands, and they may never
|
||||
notice that it's actually doing something else behind the scenes. It
|
||||
will also mean that your installation process is compatible with older
|
||||
versions of tools like CPAN and CPANPLUS.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::Build>(3), L<ExtUtils::MakeMaker>(3)
|
||||
|
||||
|
||||
=cut
|
||||
59
inc/Module-Build/Module/Build/Config.pm
Normal file
59
inc/Module-Build/Module/Build/Config.pm
Normal file
@@ -0,0 +1,59 @@
|
||||
package Module::Build::Config;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Config;
|
||||
|
||||
sub new {
|
||||
my ($pack, %args) = @_;
|
||||
return bless {
|
||||
stack => {},
|
||||
values => $args{values} || {},
|
||||
}, $pack;
|
||||
}
|
||||
|
||||
sub get {
|
||||
my ($self, $key) = @_;
|
||||
return $self->{values}{$key} if ref($self) && exists $self->{values}{$key};
|
||||
return $Config{$key};
|
||||
}
|
||||
|
||||
sub set {
|
||||
my ($self, $key, $val) = @_;
|
||||
$self->{values}{$key} = $val;
|
||||
}
|
||||
|
||||
sub push {
|
||||
my ($self, $key, $val) = @_;
|
||||
push @{$self->{stack}{$key}}, $self->{values}{$key}
|
||||
if exists $self->{values}{$key};
|
||||
$self->{values}{$key} = $val;
|
||||
}
|
||||
|
||||
sub pop {
|
||||
my ($self, $key) = @_;
|
||||
|
||||
my $val = delete $self->{values}{$key};
|
||||
if ( exists $self->{stack}{$key} ) {
|
||||
$self->{values}{$key} = pop @{$self->{stack}{$key}};
|
||||
delete $self->{stack}{$key} unless @{$self->{stack}{$key}};
|
||||
}
|
||||
|
||||
return $val;
|
||||
}
|
||||
|
||||
sub values_set {
|
||||
my $self = shift;
|
||||
return undef unless ref($self);
|
||||
return $self->{values};
|
||||
}
|
||||
|
||||
sub all_config {
|
||||
my $self = shift;
|
||||
my $v = ref($self) ? $self->{values} : {};
|
||||
return {%Config, %$v};
|
||||
}
|
||||
|
||||
1;
|
||||
201
inc/Module-Build/Module/Build/ConfigData.pm
Normal file
201
inc/Module-Build/Module/Build/ConfigData.pm
Normal file
@@ -0,0 +1,201 @@
|
||||
package Module::Build::ConfigData;
|
||||
use strict;
|
||||
my $arrayref = eval do {local $/; <DATA>}
|
||||
or die "Couldn't load ConfigData data: $@";
|
||||
close DATA;
|
||||
my ($config, $features, $auto_features) = @$arrayref;
|
||||
|
||||
sub config { $config->{$_[1]} }
|
||||
|
||||
sub set_config { $config->{$_[1]} = $_[2] }
|
||||
sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
|
||||
|
||||
sub auto_feature_names { grep !exists $features->{$_}, keys %$auto_features }
|
||||
|
||||
sub feature_names {
|
||||
my @features = (keys %$features, auto_feature_names());
|
||||
@features;
|
||||
}
|
||||
|
||||
sub config_names { keys %$config }
|
||||
|
||||
sub write {
|
||||
my $me = __FILE__;
|
||||
require IO::File;
|
||||
|
||||
# Can't use Module::Build::Dumper here because M::B is only a
|
||||
# build-time prereq of this module
|
||||
require Data::Dumper;
|
||||
|
||||
my $mode_orig = (stat $me)[2] & 07777;
|
||||
chmod($mode_orig | 0222, $me); # Make it writeable
|
||||
my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
|
||||
seek($fh, 0, 0);
|
||||
while (<$fh>) {
|
||||
last if /^__DATA__$/;
|
||||
}
|
||||
die "Couldn't find __DATA__ token in $me" if eof($fh);
|
||||
|
||||
seek($fh, tell($fh), 0);
|
||||
my $data = [$config, $features, $auto_features];
|
||||
$fh->print( 'do{ my '
|
||||
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
|
||||
. '$x; }' );
|
||||
truncate($fh, tell($fh));
|
||||
$fh->close;
|
||||
|
||||
chmod($mode_orig, $me)
|
||||
or warn "Couldn't restore permissions on $me: $!";
|
||||
}
|
||||
|
||||
sub feature {
|
||||
my ($package, $key) = @_;
|
||||
return $features->{$key} if exists $features->{$key};
|
||||
|
||||
my $info = $auto_features->{$key} or return 0;
|
||||
|
||||
# Under perl 5.005, each(%$foo) isn't working correctly when $foo
|
||||
# was reanimated with Data::Dumper and eval(). Not sure why, but
|
||||
# copying to a new hash seems to solve it.
|
||||
my %info = %$info;
|
||||
|
||||
require Module::Build; # XXX should get rid of this
|
||||
while (my ($type, $prereqs) = each %info) {
|
||||
next if $type eq 'description' || $type eq 'recommends';
|
||||
|
||||
my %p = %$prereqs; # Ditto here.
|
||||
while (my ($modname, $spec) = each %p) {
|
||||
my $status = Module::Build->check_installed_status($modname, $spec);
|
||||
if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
|
||||
if ( ! eval "require $modname; 1" ) { return 0; }
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::ConfigData - Configuration for Module::Build
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Module::Build::ConfigData;
|
||||
$value = Module::Build::ConfigData->config('foo');
|
||||
$value = Module::Build::ConfigData->feature('bar');
|
||||
|
||||
@names = Module::Build::ConfigData->config_names;
|
||||
@names = Module::Build::ConfigData->feature_names;
|
||||
|
||||
Module::Build::ConfigData->set_config(foo => $new_value);
|
||||
Module::Build::ConfigData->set_feature(bar => $new_value);
|
||||
Module::Build::ConfigData->write; # Save changes
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module holds the configuration data for the C<Module::Build>
|
||||
module. It also provides a programmatic interface for getting or
|
||||
setting that configuration data. Note that in order to actually make
|
||||
changes, you'll have to have write access to the C<Module::Build::ConfigData>
|
||||
module, and you should attempt to understand the repercussions of your
|
||||
actions.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item config($name)
|
||||
|
||||
Given a string argument, returns the value of the configuration item
|
||||
by that name, or C<undef> if no such item exists.
|
||||
|
||||
=item feature($name)
|
||||
|
||||
Given a string argument, returns the value of the feature by that
|
||||
name, or C<undef> if no such feature exists.
|
||||
|
||||
=item set_config($name, $value)
|
||||
|
||||
Sets the configuration item with the given name to the given value.
|
||||
The value may be any Perl scalar that will serialize correctly using
|
||||
C<Data::Dumper>. This includes references, objects (usually), and
|
||||
complex data structures. It probably does not include transient
|
||||
things like filehandles or sockets.
|
||||
|
||||
=item set_feature($name, $value)
|
||||
|
||||
Sets the feature with the given name to the given boolean value. The
|
||||
value will be converted to 0 or 1 automatically.
|
||||
|
||||
=item config_names()
|
||||
|
||||
Returns a list of all the names of config items currently defined in
|
||||
C<Module::Build::ConfigData>, or in scalar context the number of items.
|
||||
|
||||
=item feature_names()
|
||||
|
||||
Returns a list of all the names of features currently defined in
|
||||
C<Module::Build::ConfigData>, or in scalar context the number of features.
|
||||
|
||||
=item auto_feature_names()
|
||||
|
||||
Returns a list of all the names of features whose availability is
|
||||
dynamically determined, or in scalar context the number of such
|
||||
features. Does not include such features that have later been set to
|
||||
a fixed value.
|
||||
|
||||
=item write()
|
||||
|
||||
Commits any changes from C<set_config()> and C<set_feature()> to disk.
|
||||
Requires write access to the C<Module::Build::ConfigData> module.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
C<Module::Build::ConfigData> was automatically created using C<Module::Build>.
|
||||
C<Module::Build> was written by Ken Williams, but he holds no
|
||||
authorship claim or copyright claim to the contents of C<Module::Build::ConfigData>.
|
||||
|
||||
=cut
|
||||
|
||||
__DATA__
|
||||
|
||||
do{ my $x = [
|
||||
{},
|
||||
{},
|
||||
{
|
||||
'YAML_support' => {
|
||||
'requires' => {
|
||||
'YAML' => ' >= 0.35, != 0.49_01 '
|
||||
},
|
||||
'description' => 'Use YAML.pm to write META.yml files'
|
||||
},
|
||||
'manpage_support' => {
|
||||
'requires' => {
|
||||
'Pod::Man' => 0
|
||||
},
|
||||
'description' => 'Create Unix man pages'
|
||||
},
|
||||
'C_support' => {
|
||||
'requires' => {
|
||||
'ExtUtils::CBuilder' => '0.15'
|
||||
},
|
||||
'recommends' => {
|
||||
'ExtUtils::ParseXS' => '1.02'
|
||||
},
|
||||
'description' => 'Compile/link C & XS code'
|
||||
},
|
||||
'HTML_support' => {
|
||||
'requires' => {
|
||||
'Pod::Html' => 0
|
||||
},
|
||||
'description' => 'Create HTML documentation'
|
||||
}
|
||||
}
|
||||
];
|
||||
$x; }
|
||||
529
inc/Module-Build/Module/Build/Cookbook.pm
Normal file
529
inc/Module-Build/Module/Build/Cookbook.pm
Normal file
@@ -0,0 +1,529 @@
|
||||
package Module::Build::Cookbook;
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Cookbook - Examples of Module::Build Usage
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<Module::Build> isn't conceptually very complicated, but examples are
|
||||
always helpful. The following recipes should help developers and/or
|
||||
installers put together the pieces from the other parts of the
|
||||
documentation.
|
||||
|
||||
|
||||
=head1 BASIC RECIPES
|
||||
|
||||
|
||||
=head2 Installing modules that use Module::Build
|
||||
|
||||
In most cases, you can just issue the following commands:
|
||||
|
||||
perl Build.PL
|
||||
./Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
||||
There's nothing complicated here - first you're running a script
|
||||
called F<Build.PL>, then you're running a (newly-generated) script
|
||||
called F<Build> and passing it various arguments.
|
||||
|
||||
The exact commands may vary a bit depending on how you invoke perl
|
||||
scripts on your system. For instance, if you have multiple versions
|
||||
of perl installed, you can install to one particular perl's library
|
||||
directories like so:
|
||||
|
||||
/usr/bin/perl5.8.1 Build.PL
|
||||
./Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
||||
If you're on Windows where the current directory is always searched
|
||||
first for scripts, you'll probably do something like this:
|
||||
|
||||
perl Build.PL
|
||||
Build
|
||||
Build test
|
||||
Build install
|
||||
|
||||
On the old Mac OS (version 9 or lower) using MacPerl, you can
|
||||
double-click on the F<Build.PL> script to create the F<Build> script,
|
||||
then double-click on the F<Build> script to run its C<build>, C<test>,
|
||||
and C<install> actions.
|
||||
|
||||
The F<Build> script knows what perl was used to run F<Build.PL>, so
|
||||
you don't need to re-invoke the F<Build> script with the complete perl
|
||||
path each time. If you invoke it with the I<wrong> perl path, you'll
|
||||
get a warning or a fatal error.
|
||||
|
||||
=head2 Modifying Config.pm values
|
||||
|
||||
C<Module::Build> relies heavily on various values from perl's
|
||||
C<Config.pm> to do its work. For example, default installation paths
|
||||
are given by C<installsitelib> and C<installvendorman3dir> and
|
||||
friends, C linker & compiler settings are given by C<ld>,
|
||||
C<lddlflags>, C<cc>, C<ccflags>, and so on. I<If you're pretty sure
|
||||
you know what you're doing>, you can tell C<Module::Build> to pretend
|
||||
there are different values in F<Config.pm> than what's really there,
|
||||
by passing arguments for the C<--config> parameter on the command
|
||||
line:
|
||||
|
||||
perl Build.PL --config cc=gcc --config ld=gcc
|
||||
|
||||
Inside the C<Build.PL> script the same thing can be accomplished by
|
||||
passing values for the C<config> parameter to C<new()>:
|
||||
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
...
|
||||
config => { cc => 'gcc', ld => 'gcc' },
|
||||
...
|
||||
);
|
||||
|
||||
In custom build code, the same thing can be accomplished by calling
|
||||
the L<Module::Build/config> method:
|
||||
|
||||
$build->config( cc => 'gcc' ); # Set
|
||||
$build->config( ld => 'gcc' ); # Set
|
||||
...
|
||||
my $linker = $build->config('ld'); # Get
|
||||
|
||||
|
||||
=head2 Installing modules using the programmatic interface
|
||||
|
||||
If you need to build, test, and/or install modules from within some
|
||||
other perl code (as opposed to having the user type installation
|
||||
commands at the shell), you can use the programmatic interface.
|
||||
Create a Module::Build object (or an object of a custom Module::Build
|
||||
subclass) and then invoke its C<dispatch()> method to run various
|
||||
actions.
|
||||
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
requires => { 'Some::Module' => '1.23' },
|
||||
);
|
||||
$build->dispatch('build');
|
||||
$build->dispatch('test', verbose => 1);
|
||||
$build->dispatch('install');
|
||||
|
||||
The first argument to C<dispatch()> is the name of the action, and any
|
||||
following arguments are named parameters.
|
||||
|
||||
This is the interface we use to test Module::Build itself in the
|
||||
regression tests.
|
||||
|
||||
|
||||
=head2 Installing to a temporary directory
|
||||
|
||||
To create packages for package managers like RedHat's C<rpm> or
|
||||
Debian's C<deb>, you may need to install to a temporary directory
|
||||
first and then create the package from that temporary installation.
|
||||
To do this, specify the C<destdir> parameter to the C<install> action:
|
||||
|
||||
./Build install --destdir /tmp/my-package-1.003
|
||||
|
||||
This essentially just prepends all the installation paths with the
|
||||
F</tmp/my-package-1.003> directory.
|
||||
|
||||
|
||||
=head2 Installing to a non-standard directory
|
||||
|
||||
To install to a non-standard directory (for example, if you don't have
|
||||
permission to install in the system-wide directories), you can use the
|
||||
C<install_base> or C<prefix> parameters:
|
||||
|
||||
./Build install --install_base /foo/bar
|
||||
|
||||
See L<Module::Build/"INSTALL PATHS"> for a much more complete
|
||||
discussion of how installation paths are determined.
|
||||
|
||||
|
||||
=head2 Installing in the same location as ExtUtils::MakeMaker
|
||||
|
||||
With the introduction of C<--prefix> in Module::Build 0.28 and
|
||||
C<INSTALL_BASE> in C<ExtUtils::MakeMaker> 6.31 its easy to get them both
|
||||
to install to the same locations.
|
||||
|
||||
First, ensure you have at least version 0.28 of Module::Build
|
||||
installed and 6.31 of C<ExtUtils::MakeMaker>. Prior versions have
|
||||
differing (and in some cases quite strange) installation behaviors.
|
||||
|
||||
The following installation flags are equivalent between
|
||||
C<ExtUtils::MakeMaker> and C<Module::Build>.
|
||||
|
||||
MakeMaker Module::Build
|
||||
PREFIX=... --prefix ...
|
||||
INSTALL_BASE=... --install_base ...
|
||||
DESTDIR=... --destdir ...
|
||||
LIB=... --install_path lib=...
|
||||
INSTALLDIRS=... --installdirs ...
|
||||
INSTALLDIRS=perl --installdirs core
|
||||
UNINST=... --uninst ...
|
||||
INC=... --extra_compiler_flags ...
|
||||
POLLUTE=1 --extra_compiler_flags -DPERL_POLLUTE
|
||||
|
||||
For example, if you are currently installing C<MakeMaker> modules with
|
||||
this command:
|
||||
|
||||
perl Makefile.PL PREFIX=~
|
||||
make test
|
||||
make install UNINST=1
|
||||
|
||||
You can install into the same location with Module::Build using this:
|
||||
|
||||
perl Build.PL --prefix ~
|
||||
./Build test
|
||||
./Build install --uninst 1
|
||||
|
||||
=head3 C<prefix> vs C<install_base>
|
||||
|
||||
The behavior of C<prefix> is complicated and depends on
|
||||
how your Perl is configured. The resulting installation locations
|
||||
will vary from machine to machine and even different installations of
|
||||
Perl on the same machine. Because of this, it's difficult to document
|
||||
where C<prefix> will place your modules.
|
||||
|
||||
In contrast, C<install_base> has predictable, easy to explain
|
||||
installation locations. Now that C<Module::Build> and C<MakeMaker> both
|
||||
have C<install_base> there is little reason to use C<prefix> other
|
||||
than to preserve your existing installation locations. If you are
|
||||
starting a fresh Perl installation we encourage you to use
|
||||
C<install_base>. If you have an existing installation installed via
|
||||
C<prefix>, consider moving it to an installation structure matching
|
||||
C<install_base> and using that instead.
|
||||
|
||||
|
||||
=head2 Running a single test file
|
||||
|
||||
C<Module::Build> supports running a single test, which enables you to
|
||||
track down errors more quickly. Use the following format:
|
||||
|
||||
./Build test --test_files t/mytest.t
|
||||
|
||||
In addition, you may want to run the test in verbose mode to get more
|
||||
informative output:
|
||||
|
||||
./Build test --test_files t/mytest.t --verbose 1
|
||||
|
||||
I run this so frequently that I define the following shell alias:
|
||||
|
||||
alias t './Build test --verbose 1 --test_files'
|
||||
|
||||
So then I can just execute C<t t/mytest.t> to run a single test.
|
||||
|
||||
|
||||
=head1 ADVANCED RECIPES
|
||||
|
||||
|
||||
=head2 Making a CPAN.pm-compatible distribution
|
||||
|
||||
New versions of CPAN.pm understand how to use a F<Build.PL> script,
|
||||
but old versions don't. If authors want to help users who have old
|
||||
versions, some form of F<Makefile.PL> should be supplied. The easiest
|
||||
way to accomplish this is to use the C<create_makefile_pl> parameter to
|
||||
C<< Module::Build->new() >> in the C<Build.PL> script, which can
|
||||
create various flavors of F<Makefile.PL> during the C<dist> action.
|
||||
|
||||
As a best practice, we recommend using the "traditional" style of
|
||||
F<Makefile.PL> unless your distribution has needs that can't be
|
||||
accomplished that way.
|
||||
|
||||
The C<Module::Build::Compat> module, which is part of
|
||||
C<Module::Build>'s distribution, is responsible for creating these
|
||||
F<Makefile.PL>s. Please see L<Module::Build::Compat> for the details.
|
||||
|
||||
|
||||
=head2 Changing the order of the build process
|
||||
|
||||
The C<build_elements> property specifies the steps C<Module::Build>
|
||||
will take when building a distribution. To change the build order,
|
||||
change the order of the entries in that property:
|
||||
|
||||
# Process pod files first
|
||||
my @e = @{$build->build_elements};
|
||||
my ($i) = grep {$e[$_] eq 'pod'} 0..$#e;
|
||||
unshift @e, splice @e, $i, 1;
|
||||
|
||||
Currently, C<build_elements> has the following default value:
|
||||
|
||||
[qw( PL support pm xs pod script )]
|
||||
|
||||
Do take care when altering this property, since there may be
|
||||
non-obvious (and non-documented!) ordering dependencies in the
|
||||
C<Module::Build> code.
|
||||
|
||||
|
||||
=head2 Adding new file types to the build process
|
||||
|
||||
Sometimes you might have extra types of files that you want to install
|
||||
alongside the standard types like F<.pm> and F<.pod> files. For
|
||||
instance, you might have a F<Bar.dat> file containing some data
|
||||
related to the C<Foo::Bar> module and you'd like for it to end up as
|
||||
F<Foo/Bar.dat> somewhere in perl's C<@INC> path so C<Foo::Bar> can
|
||||
access it easily at runtime. The following code from a sample
|
||||
C<Build.PL> file demonstrates how to accomplish this:
|
||||
|
||||
use Module::Build;
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
...other stuff here...
|
||||
);
|
||||
$build->add_build_element('dat');
|
||||
$build->create_build_script;
|
||||
|
||||
This will find all F<.dat> files in the F<lib/> directory, copy them
|
||||
to the F<blib/lib/> directory during the C<build> action, and install
|
||||
them during the C<install> action.
|
||||
|
||||
If your extra files aren't located in the C<lib/> directory in your
|
||||
distribution, you can explicitly say where they are, just as you'd do
|
||||
with F<.pm> or F<.pod> files:
|
||||
|
||||
use Module::Build;
|
||||
my $build = new Module::Build
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
dat_files => {'some/dir/Bar.dat' => 'lib/Foo/Bar.dat'},
|
||||
...other stuff here...
|
||||
);
|
||||
$build->add_build_element('dat');
|
||||
$build->create_build_script;
|
||||
|
||||
If your extra files actually need to be created on the user's machine,
|
||||
or if they need some other kind of special processing, you'll probably
|
||||
want to subclass C<Module::Build> and create a special method to
|
||||
process them, named C<process_${kind}_files()>:
|
||||
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass(code => <<'EOF');
|
||||
sub process_dat_files {
|
||||
my $self = shift;
|
||||
... locate and process *.dat files,
|
||||
... and create something in blib/lib/
|
||||
}
|
||||
EOF
|
||||
my $build = $class->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
...other stuff here...
|
||||
);
|
||||
$build->add_build_element('dat');
|
||||
$build->create_build_script;
|
||||
|
||||
If your extra files don't go in F<lib/> but in some other place, see
|
||||
L<"Adding new elements to the install process"> for how to actually
|
||||
get them installed.
|
||||
|
||||
Please note that these examples use some capabilities of Module::Build
|
||||
that first appeared in version 0.26. Before that it could
|
||||
still be done, but the simple cases took a bit more work.
|
||||
|
||||
|
||||
=head2 Adding new elements to the install process
|
||||
|
||||
By default, Module::Build creates seven subdirectories of the F<blib>
|
||||
directory during the build process: F<lib>, F<arch>, F<bin>,
|
||||
F<script>, F<bindoc>, F<libdoc>, and F<html> (some of these may be
|
||||
missing or empty if there's nothing to go in them). Anything copied
|
||||
to these directories during the build will eventually be installed
|
||||
during the C<install> action (see L<Module::Build/"INSTALL PATHS">.
|
||||
|
||||
If you need to create a new custom type of installable element, e.g. C<conf>,
|
||||
then you need to tell Module::Build where things in F<blib/conf/>
|
||||
should be installed. To do this, use the C<install_path> parameter to
|
||||
the C<new()> method:
|
||||
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
...other stuff here...
|
||||
install_path => { conf => $installation_path }
|
||||
);
|
||||
|
||||
Or you can call the C<install_path()> method later:
|
||||
|
||||
$build->install_path(conf => $installation_path);
|
||||
|
||||
The user may also specify the path on the command line:
|
||||
|
||||
perl Build.PL --install_path conf=/foo/path/etc
|
||||
|
||||
The important part, though, is that I<somehow> the install path needs
|
||||
to be set, or else nothing in the F<blib/conf/> directory will get
|
||||
installed, and a runtime error during the C<install> action will
|
||||
result.
|
||||
|
||||
See also L<"Adding new file types to the build process"> for how to
|
||||
create the stuff in F<blib/conf/> in the first place.
|
||||
|
||||
|
||||
=head1 EXAMPLES ON CPAN
|
||||
|
||||
Several distributions on CPAN are making good use of various features
|
||||
of Module::Build. They can serve as real-world examples for others.
|
||||
|
||||
|
||||
=head2 SVN-Notify-Mirror
|
||||
|
||||
L<http://search.cpan.org/~jpeacock/SVN-Notify-Mirror/>
|
||||
|
||||
John Peacock, author of the C<SVN-Notify-Mirror> distribution, says:
|
||||
|
||||
=over 4
|
||||
|
||||
=item 1. Using C<auto_features>, I check to see whether two optional
|
||||
modules are available - SVN::Notify::Config and Net::SSH;
|
||||
|
||||
=item 2. If the S::N::Config module is loaded, I automatically
|
||||
generate test files for it during Build (using the C<PL_files>
|
||||
property).
|
||||
|
||||
=item 3. If the C<ssh_feature> is available, I ask if the user wishes
|
||||
to perform the ssh tests (since it requires a little preliminary
|
||||
setup);
|
||||
|
||||
=item 4. Only if the user has C<ssh_feature> and answers yes to the
|
||||
testing, do I generate a test file.
|
||||
|
||||
I'm sure I could not have handled this complexity with EU::MM, but it
|
||||
was very easy to do with M::B.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head2 Modifying an action
|
||||
|
||||
Sometimes you might need an to have an action, say C<./Build install>,
|
||||
do something unusual. For instance, you might need to change the
|
||||
ownership of a file or do something else peculiar to your application.
|
||||
|
||||
You can subclass C<Module::Build> on the fly using the C<subclass()>
|
||||
method and override the methods that perform the actions. You may
|
||||
need to read through C<Module::Build::Authoring> and
|
||||
C<Module::Build::API> to find the methods you want to override. All
|
||||
"action" methods are implemented by a method called "ACTION_" followed
|
||||
by the action's name, so here's an example of how it would work for
|
||||
the C<install> action:
|
||||
|
||||
# Build.PL
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass(
|
||||
class => "Module::Build::Custom",
|
||||
code => <<'SUBCLASS' );
|
||||
|
||||
sub ACTION_install {
|
||||
my $self = shift;
|
||||
# YOUR CODE HERE
|
||||
$self->SUPER::ACTION_install;
|
||||
}
|
||||
SUBCLASS
|
||||
|
||||
$class->new(
|
||||
module_name => 'Your::Module',
|
||||
# rest of the usual Module::Build parameters
|
||||
)->create_build_script;
|
||||
|
||||
|
||||
=head2 Adding an action
|
||||
|
||||
You can add a new C<./Build> action simply by writing the method for
|
||||
it in your subclass. Use C<depends_on> to declare that another action
|
||||
must have been run before your action.
|
||||
|
||||
For example, let's say you wanted to be able to write C<./Build
|
||||
commit> to test your code and commit it to Subversion.
|
||||
|
||||
# Build.PL
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass(
|
||||
class => "Module::Build::Custom",
|
||||
code => <<'SUBCLASS' );
|
||||
|
||||
sub ACTION_commit {
|
||||
my $self = shift;
|
||||
|
||||
$self->depends_on("test");
|
||||
$self->do_system(qw(svn commit));
|
||||
}
|
||||
SUBCLASS
|
||||
|
||||
|
||||
=head2 Bundling Module::Build
|
||||
|
||||
Note: This section probably needs an update as the technology improves
|
||||
(see contrib/bundle.pl in the distribution).
|
||||
|
||||
Suppose you want to use some new-ish features of Module::Build,
|
||||
e.g. newer than the version of Module::Build your users are likely to
|
||||
already have installed on their systems. The first thing you should
|
||||
do is set C<configure_requires> to your minimum version of
|
||||
Module::Build. See L<Module::Build::Authoring>.
|
||||
|
||||
But not every build system honors C<configure_requires> yet. Here's
|
||||
how you can ship a copy of Module::Build, but still use a newer
|
||||
installed version to take advantage of any bug fixes and upgrades.
|
||||
|
||||
First, install Module::Build into F<Your-Project/inc/Module-Build>.
|
||||
CPAN will not index anything in the F<inc> directory so this copy will
|
||||
not show up in CPAN searches.
|
||||
|
||||
cd Module-Build
|
||||
perl Build.PL --install_base /path/to/Your-Project/inc/Module-Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
||||
You should now have all the Module::Build .pm files in
|
||||
F<Your-Project/inc/Module-Build/lib/perl5>.
|
||||
|
||||
Next, add this to the top of your F<Build.PL>.
|
||||
|
||||
my $Bundled_MB = 0.30; # or whatever version it was.
|
||||
|
||||
# Find out what version of Module::Build is installed or fail quietly.
|
||||
# This should be cross-platform.
|
||||
my $Installed_MB =
|
||||
`$^X -e "eval q{require Module::Build; print Module::Build->VERSION} or exit 1";
|
||||
|
||||
# some operating systems put a newline at the end of every print.
|
||||
chomp $Installed_MB;
|
||||
|
||||
$Installed_MB = 0 if $?;
|
||||
|
||||
# Use our bundled copy of Module::Build if it's newer than the installed.
|
||||
unshift @INC, "inc/Module-Build/lib/perl5" if $Bundled_MB > $Installed_MB;
|
||||
|
||||
require Module::Build;
|
||||
|
||||
And write the rest of your F<Build.PL> normally. Module::Build will
|
||||
remember your change to C<@INC> and use it when you run F<./Build>.
|
||||
|
||||
In the future, we hope to provide a more automated solution for this
|
||||
scenario; see C<inc/latest.pm> in the Module::Build distribution for
|
||||
one indication of the direction we're moving.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2008 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), L<Module::Build>(3), L<Module::Build::Authoring>(3),
|
||||
L<Module::Build::API>(3)
|
||||
|
||||
=cut
|
||||
19
inc/Module-Build/Module/Build/Dumper.pm
Normal file
19
inc/Module-Build/Module/Build/Dumper.pm
Normal file
@@ -0,0 +1,19 @@
|
||||
package Module::Build::Dumper;
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
|
||||
# This is just a split-out of a wrapper function to do Data::Dumper
|
||||
# stuff "the right way". See:
|
||||
# http://groups.google.com/group/perl.module.build/browse_thread/thread/c8065052b2e0d741
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub _data_dump {
|
||||
my ($self, $data) = @_;
|
||||
return ("do{ my "
|
||||
. Data::Dumper->new([$data],['x'])->Purity(1)->Terse(0)->Dump()
|
||||
. '$x; }')
|
||||
}
|
||||
|
||||
1;
|
||||
471
inc/Module-Build/Module/Build/ModuleInfo.pm
Normal file
471
inc/Module-Build/Module/Build/ModuleInfo.pm
Normal file
@@ -0,0 +1,471 @@
|
||||
# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
|
||||
# vim:ts=8:sw=2:et:sta:sts=2
|
||||
package Module::Build::ModuleInfo;
|
||||
|
||||
# This module provides routines to gather information about
|
||||
# perl modules (assuming this may be expanded in the distant
|
||||
# parrot future to look at other types of modules).
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
use File::Spec;
|
||||
use IO::File;
|
||||
use Module::Build::Version;
|
||||
|
||||
|
||||
my $PKG_REGEXP = qr{ # match a package declaration
|
||||
^[\s\{;]* # intro chars on a line
|
||||
package # the word 'package'
|
||||
\s+ # whitespace
|
||||
([\w:]+) # a package name
|
||||
\s* # optional whitespace
|
||||
; # semicolon line terminator
|
||||
}x;
|
||||
|
||||
my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
|
||||
([\$*]) # sigil - $ or *
|
||||
(
|
||||
( # optional leading package name
|
||||
(?:::|\')? # possibly starting like just :: (<28> la $::VERSION)
|
||||
(?:\w+(?:::|\'))* # Foo::Bar:: ...
|
||||
)?
|
||||
VERSION
|
||||
)\b
|
||||
}x;
|
||||
|
||||
my $VERS_REGEXP = qr{ # match a VERSION definition
|
||||
(?:
|
||||
\(\s*$VARNAME_REGEXP\s*\) # with parens
|
||||
|
|
||||
$VARNAME_REGEXP # without parens
|
||||
)
|
||||
\s*
|
||||
=[^=~] # = but not ==, nor =~
|
||||
}x;
|
||||
|
||||
|
||||
sub new_from_file {
|
||||
my $class = shift;
|
||||
my $filename = File::Spec->rel2abs( shift );
|
||||
|
||||
return undef unless defined( $filename ) && -f $filename;
|
||||
return $class->_init(undef, $filename, @_);
|
||||
}
|
||||
|
||||
sub new_from_module {
|
||||
my $class = shift;
|
||||
my $module = shift;
|
||||
my %props = @_;
|
||||
|
||||
$props{inc} ||= \@INC;
|
||||
my $filename = $class->find_module_by_name( $module, $props{inc} );
|
||||
return undef unless defined( $filename ) && -f $filename;
|
||||
return $class->_init($module, $filename, %props);
|
||||
}
|
||||
|
||||
sub _init {
|
||||
my $class = shift;
|
||||
my $module = shift;
|
||||
my $filename = shift;
|
||||
my %props = @_;
|
||||
|
||||
my( %valid_props, @valid_props );
|
||||
@valid_props = qw( collect_pod inc );
|
||||
@valid_props{@valid_props} = delete( @props{@valid_props} );
|
||||
warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
|
||||
|
||||
my %data = (
|
||||
module => $module,
|
||||
filename => $filename,
|
||||
version => undef,
|
||||
packages => [],
|
||||
versions => {},
|
||||
pod => {},
|
||||
pod_headings => [],
|
||||
collect_pod => 0,
|
||||
|
||||
%valid_props,
|
||||
);
|
||||
|
||||
my $self = bless(\%data, $class);
|
||||
|
||||
$self->_parse_file();
|
||||
|
||||
unless($self->{module} and length($self->{module})) {
|
||||
my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
|
||||
if($f =~ /\.pm$/) {
|
||||
$f =~ s/\..+$//;
|
||||
my @candidates = grep /$f$/, @{$self->{packages}};
|
||||
$self->{module} = shift(@candidates); # punt
|
||||
}
|
||||
else {
|
||||
if(grep /main/, @{$self->{packages}}) {
|
||||
$self->{module} = 'main';
|
||||
}
|
||||
else {
|
||||
$self->{module} = $self->{packages}[0] || '';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
$self->{version} = $self->{versions}{$self->{module}}
|
||||
if defined( $self->{module} );
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
# class method
|
||||
sub _do_find_module {
|
||||
my $class = shift;
|
||||
my $module = shift || die 'find_module_by_name() requires a package name';
|
||||
my $dirs = shift || \@INC;
|
||||
|
||||
my $file = File::Spec->catfile(split( /::/, $module));
|
||||
foreach my $dir ( @$dirs ) {
|
||||
my $testfile = File::Spec->catfile($dir, $file);
|
||||
return [ File::Spec->rel2abs( $testfile ), $dir ]
|
||||
if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
|
||||
return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
|
||||
if -e "$testfile.pm";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# class method
|
||||
sub find_module_by_name {
|
||||
my $found = shift()->_do_find_module(@_) or return;
|
||||
return $found->[0];
|
||||
}
|
||||
|
||||
# class method
|
||||
sub find_module_dir_by_name {
|
||||
my $found = shift()->_do_find_module(@_) or return;
|
||||
return $found->[1];
|
||||
}
|
||||
|
||||
|
||||
# given a line of perl code, attempt to parse it if it looks like a
|
||||
# $VERSION assignment, returning sigil, full name, & package name
|
||||
sub _parse_version_expression {
|
||||
my $self = shift;
|
||||
my $line = shift;
|
||||
|
||||
my( $sig, $var, $pkg );
|
||||
if ( $line =~ $VERS_REGEXP ) {
|
||||
( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
|
||||
if ( $pkg ) {
|
||||
$pkg = ($pkg eq '::') ? 'main' : $pkg;
|
||||
$pkg =~ s/::$//;
|
||||
}
|
||||
}
|
||||
|
||||
return ( $sig, $var, $pkg );
|
||||
}
|
||||
|
||||
sub _parse_file {
|
||||
my $self = shift;
|
||||
|
||||
my $filename = $self->{filename};
|
||||
my $fh = IO::File->new( $filename )
|
||||
or die( "Can't open '$filename': $!" );
|
||||
|
||||
$self->_parse_fh($fh);
|
||||
}
|
||||
|
||||
sub _parse_fh {
|
||||
my ($self, $fh) = @_;
|
||||
|
||||
my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
|
||||
my( @pkgs, %vers, %pod, @pod );
|
||||
my $pkg = 'main';
|
||||
my $pod_sect = '';
|
||||
my $pod_data = '';
|
||||
|
||||
while (defined( my $line = <$fh> )) {
|
||||
my $line_num = $.;
|
||||
|
||||
chomp( $line );
|
||||
next if $line =~ /^\s*#/;
|
||||
|
||||
$in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
|
||||
|
||||
# Would be nice if we could also check $in_string or something too
|
||||
last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
|
||||
|
||||
if ( $in_pod || $line =~ /^=cut/ ) {
|
||||
|
||||
if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
|
||||
push( @pod, $1 );
|
||||
if ( $self->{collect_pod} && length( $pod_data ) ) {
|
||||
$pod{$pod_sect} = $pod_data;
|
||||
$pod_data = '';
|
||||
}
|
||||
$pod_sect = $1;
|
||||
|
||||
|
||||
} elsif ( $self->{collect_pod} ) {
|
||||
$pod_data .= "$line\n";
|
||||
|
||||
}
|
||||
|
||||
} else {
|
||||
|
||||
$pod_sect = '';
|
||||
$pod_data = '';
|
||||
|
||||
# parse $line to see if it's a $VERSION declaration
|
||||
my( $vers_sig, $vers_fullname, $vers_pkg ) =
|
||||
$self->_parse_version_expression( $line );
|
||||
|
||||
if ( $line =~ $PKG_REGEXP ) {
|
||||
$pkg = $1;
|
||||
push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
|
||||
$vers{$pkg} = undef unless exists( $vers{$pkg} );
|
||||
$need_vers = 1;
|
||||
|
||||
# VERSION defined with full package spec, i.e. $Module::VERSION
|
||||
} elsif ( $vers_fullname && $vers_pkg ) {
|
||||
push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
|
||||
$need_vers = 0 if $vers_pkg eq $pkg;
|
||||
|
||||
unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
|
||||
$vers{$vers_pkg} =
|
||||
$self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
|
||||
} else {
|
||||
# Warn unless the user is using the "$VERSION = eval
|
||||
# $VERSION" idiom (though there are probably other idioms
|
||||
# that we should watch out for...)
|
||||
warn <<"EOM" unless $line =~ /=\s*eval/;
|
||||
Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
|
||||
ignoring subsequent declaration on line $line_num.
|
||||
EOM
|
||||
}
|
||||
|
||||
# first non-comment line in undeclared package main is VERSION
|
||||
} elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
|
||||
$need_vers = 0;
|
||||
my $v =
|
||||
$self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
|
||||
$vers{$pkg} = $v;
|
||||
push( @pkgs, 'main' );
|
||||
|
||||
# first non-comment line in undeclared package defines package main
|
||||
} elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
|
||||
$need_vers = 1;
|
||||
$vers{main} = '';
|
||||
push( @pkgs, 'main' );
|
||||
|
||||
# only keep if this is the first $VERSION seen
|
||||
} elsif ( $vers_fullname && $need_vers ) {
|
||||
$need_vers = 0;
|
||||
my $v =
|
||||
$self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
|
||||
|
||||
|
||||
unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
|
||||
$vers{$pkg} = $v;
|
||||
} else {
|
||||
warn <<"EOM";
|
||||
Package '$pkg' already declared with version '$vers{$pkg}'
|
||||
ignoring new version '$v' on line $line_num.
|
||||
EOM
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if ( $self->{collect_pod} && length($pod_data) ) {
|
||||
$pod{$pod_sect} = $pod_data;
|
||||
}
|
||||
|
||||
$self->{versions} = \%vers;
|
||||
$self->{packages} = \@pkgs;
|
||||
$self->{pod} = \%pod;
|
||||
$self->{pod_headings} = \@pod;
|
||||
}
|
||||
|
||||
{
|
||||
my $pn = 0;
|
||||
sub _evaluate_version_line {
|
||||
my $self = shift;
|
||||
my( $sigil, $var, $line ) = @_;
|
||||
|
||||
# Some of this code came from the ExtUtils:: hierarchy.
|
||||
|
||||
# We compile into $vsub because 'use version' would cause
|
||||
# compiletime/runtime issues with local()
|
||||
my $vsub;
|
||||
$pn++; # everybody gets their own package
|
||||
my $eval = qq{BEGIN { q# Hide from _packages_inside()
|
||||
#; package Module::Build::ModuleInfo::_version::p$pn;
|
||||
use Module::Build::Version;
|
||||
no strict;
|
||||
|
||||
local $sigil$var;
|
||||
\$$var=undef;
|
||||
\$vsub = sub {
|
||||
$line;
|
||||
\$$var
|
||||
};
|
||||
}};
|
||||
|
||||
local $^W;
|
||||
# Try to get the $VERSION
|
||||
eval $eval;
|
||||
warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
|
||||
if $@;
|
||||
(ref($vsub) eq 'CODE') or
|
||||
die "failed to build version sub for $self->{filename}";
|
||||
my $result = eval { $vsub->() };
|
||||
|
||||
die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@;
|
||||
|
||||
# Bless it into our own version class
|
||||
$result = Module::Build::Version->new($result);
|
||||
|
||||
return $result;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
############################################################
|
||||
|
||||
# accessors
|
||||
sub name { $_[0]->{module} }
|
||||
|
||||
sub filename { $_[0]->{filename} }
|
||||
sub packages_inside { @{$_[0]->{packages}} }
|
||||
sub pod_inside { @{$_[0]->{pod_headings}} }
|
||||
sub contains_pod { $#{$_[0]->{pod_headings}} }
|
||||
|
||||
sub version {
|
||||
my $self = shift;
|
||||
my $mod = shift || $self->{module};
|
||||
my $vers;
|
||||
if ( defined( $mod ) && length( $mod ) &&
|
||||
exists( $self->{versions}{$mod} ) ) {
|
||||
return $self->{versions}{$mod};
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
sub pod {
|
||||
my $self = shift;
|
||||
my $sect = shift;
|
||||
if ( defined( $sect ) && length( $sect ) &&
|
||||
exists( $self->{pod}{$sect} ) ) {
|
||||
return $self->{pod}{$sect};
|
||||
} else {
|
||||
return undef;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=for :stopwords ModuleInfo
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ModuleInfo - Gather package and POD information from a perl module file
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
=over 4
|
||||
|
||||
=item new_from_file($filename, collect_pod => 1)
|
||||
|
||||
Construct a C<ModuleInfo> object given the path to a file. Takes an optional
|
||||
argument C<collect_pod> which is a boolean that determines whether
|
||||
POD data is collected and stored for reference. POD data is not
|
||||
collected by default. POD headings are always collected.
|
||||
|
||||
=item new_from_module($module, collect_pod => 1, inc => \@dirs)
|
||||
|
||||
Construct a C<ModuleInfo> object given a module or package name. In addition
|
||||
to accepting the C<collect_pod> argument as described above, this
|
||||
method accepts a C<inc> argument which is a reference to an array of
|
||||
of directories to search for the module. If none are given, the
|
||||
default is @INC.
|
||||
|
||||
=item name()
|
||||
|
||||
Returns the name of the package represented by this module. If there
|
||||
are more than one packages, it makes a best guess based on the
|
||||
filename. If it's a script (i.e. not a *.pm) the package name is
|
||||
'main'.
|
||||
|
||||
=item version($package)
|
||||
|
||||
Returns the version as defined by the $VERSION variable for the
|
||||
package as returned by the C<name> method if no arguments are
|
||||
given. If given the name of a package it will attempt to return the
|
||||
version of that package if it is specified in the file.
|
||||
|
||||
=item filename()
|
||||
|
||||
Returns the absolute path to the file.
|
||||
|
||||
=item packages_inside()
|
||||
|
||||
Returns a list of packages.
|
||||
|
||||
=item pod_inside()
|
||||
|
||||
Returns a list of POD sections.
|
||||
|
||||
=item contains_pod()
|
||||
|
||||
Returns true if there is any POD in the file.
|
||||
|
||||
=item pod($section)
|
||||
|
||||
Returns the POD data in the given section.
|
||||
|
||||
=item find_module_by_name($module, \@dirs)
|
||||
|
||||
Returns the path to a module given the module or package name. A list
|
||||
of directories can be passed in as an optional parameter, otherwise
|
||||
@INC is searched.
|
||||
|
||||
Can be called as either an object or a class method.
|
||||
|
||||
=item find_module_dir_by_name($module, \@dirs)
|
||||
|
||||
Returns the entry in C<@dirs> (or C<@INC> by default) that contains
|
||||
the module C<$module>. A list of directories can be passed in as an
|
||||
optional parameter, otherwise @INC is searched.
|
||||
|
||||
Can be called as either an object or a class method.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), L<Module::Build>(3)
|
||||
|
||||
=cut
|
||||
|
||||
296
inc/Module-Build/Module/Build/Notes.pm
Normal file
296
inc/Module-Build/Module/Build/Notes.pm
Normal file
@@ -0,0 +1,296 @@
|
||||
package Module::Build::Notes;
|
||||
|
||||
# A class for persistent hashes
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Data::Dumper;
|
||||
use IO::File;
|
||||
use Module::Build::Dumper;
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
|
||||
my $self = bless {
|
||||
disk => {},
|
||||
new => {},
|
||||
file => $file,
|
||||
%args,
|
||||
}, $class;
|
||||
}
|
||||
|
||||
sub restore {
|
||||
my $self = shift;
|
||||
|
||||
my $fh = IO::File->new("< $self->{file}") or die "Can't read $self->{file}: $!";
|
||||
$self->{disk} = eval do {local $/; <$fh>};
|
||||
die $@ if $@;
|
||||
$self->{new} = {};
|
||||
}
|
||||
|
||||
sub access {
|
||||
my $self = shift;
|
||||
return $self->read() unless @_;
|
||||
|
||||
my $key = shift;
|
||||
return $self->read($key) unless @_;
|
||||
|
||||
my $value = shift;
|
||||
$self->write({ $key => $value });
|
||||
return $self->read($key);
|
||||
}
|
||||
|
||||
sub has_data {
|
||||
my $self = shift;
|
||||
return keys %{$self->read()} > 0;
|
||||
}
|
||||
|
||||
sub exists {
|
||||
my ($self, $key) = @_;
|
||||
return exists($self->{new}{$key}) || exists($self->{disk}{$key});
|
||||
}
|
||||
|
||||
sub read {
|
||||
my $self = shift;
|
||||
|
||||
if (@_) {
|
||||
# Return 1 key as a scalar
|
||||
my $key = shift;
|
||||
return $self->{new}{$key} if exists $self->{new}{$key};
|
||||
return $self->{disk}{$key};
|
||||
}
|
||||
|
||||
# Return all data
|
||||
my $out = (keys %{$self->{new}}
|
||||
? {%{$self->{disk}}, %{$self->{new}}}
|
||||
: $self->{disk});
|
||||
return wantarray ? %$out : $out;
|
||||
}
|
||||
|
||||
sub _same {
|
||||
my ($self, $x, $y) = @_;
|
||||
return 1 if !defined($x) and !defined($y);
|
||||
return 0 if !defined($x) or !defined($y);
|
||||
return $x eq $y;
|
||||
}
|
||||
|
||||
sub write {
|
||||
my ($self, $href) = @_;
|
||||
$href ||= {};
|
||||
|
||||
@{$self->{new}}{ keys %$href } = values %$href; # Merge
|
||||
|
||||
# Do some optimization to avoid unnecessary writes
|
||||
foreach my $key (keys %{ $self->{new} }) {
|
||||
next if ref $self->{new}{$key};
|
||||
next if ref $self->{disk}{$key} or !exists $self->{disk}{$key};
|
||||
delete $self->{new}{$key} if $self->_same($self->{new}{$key}, $self->{disk}{$key});
|
||||
}
|
||||
|
||||
if (my $file = $self->{file}) {
|
||||
my ($vol, $dir, $base) = File::Spec->splitpath($file);
|
||||
$dir = File::Spec->catpath($vol, $dir, '');
|
||||
return unless -e $dir && -d $dir; # The user needs to arrange for this
|
||||
|
||||
return if -e $file and !keys %{ $self->{new} }; # Nothing to do
|
||||
|
||||
@{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge
|
||||
$self->_dump($file, $self->{disk});
|
||||
|
||||
$self->{new} = {};
|
||||
}
|
||||
return $self->read;
|
||||
}
|
||||
|
||||
sub _dump {
|
||||
my ($self, $file, $data) = @_;
|
||||
|
||||
my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
|
||||
print {$fh} Module::Build::Dumper->_data_dump($data);
|
||||
}
|
||||
|
||||
sub write_config_data {
|
||||
my ($self, %args) = @_;
|
||||
|
||||
my $fh = IO::File->new("> $args{file}") or die "Can't create '$args{file}': $!";
|
||||
|
||||
printf $fh <<'EOF', $args{config_module};
|
||||
package %s;
|
||||
use strict;
|
||||
my $arrayref = eval do {local $/; <DATA>}
|
||||
or die "Couldn't load ConfigData data: $@";
|
||||
close DATA;
|
||||
my ($config, $features, $auto_features) = @$arrayref;
|
||||
|
||||
sub config { $config->{$_[1]} }
|
||||
|
||||
sub set_config { $config->{$_[1]} = $_[2] }
|
||||
sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
|
||||
|
||||
sub auto_feature_names { grep !exists $features->{$_}, keys %%$auto_features }
|
||||
|
||||
sub feature_names {
|
||||
my @features = (keys %%$features, auto_feature_names());
|
||||
@features;
|
||||
}
|
||||
|
||||
sub config_names { keys %%$config }
|
||||
|
||||
sub write {
|
||||
my $me = __FILE__;
|
||||
require IO::File;
|
||||
|
||||
# Can't use Module::Build::Dumper here because M::B is only a
|
||||
# build-time prereq of this module
|
||||
require Data::Dumper;
|
||||
|
||||
my $mode_orig = (stat $me)[2] & 07777;
|
||||
chmod($mode_orig | 0222, $me); # Make it writeable
|
||||
my $fh = IO::File->new($me, 'r+') or die "Can't rewrite $me: $!";
|
||||
seek($fh, 0, 0);
|
||||
while (<$fh>) {
|
||||
last if /^__DATA__$/;
|
||||
}
|
||||
die "Couldn't find __DATA__ token in $me" if eof($fh);
|
||||
|
||||
seek($fh, tell($fh), 0);
|
||||
my $data = [$config, $features, $auto_features];
|
||||
$fh->print( 'do{ my '
|
||||
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
|
||||
. '$x; }' );
|
||||
truncate($fh, tell($fh));
|
||||
$fh->close;
|
||||
|
||||
chmod($mode_orig, $me)
|
||||
or warn "Couldn't restore permissions on $me: $!";
|
||||
}
|
||||
|
||||
sub feature {
|
||||
my ($package, $key) = @_;
|
||||
return $features->{$key} if exists $features->{$key};
|
||||
|
||||
my $info = $auto_features->{$key} or return 0;
|
||||
|
||||
# Under perl 5.005, each(%%$foo) isn't working correctly when $foo
|
||||
# was reanimated with Data::Dumper and eval(). Not sure why, but
|
||||
# copying to a new hash seems to solve it.
|
||||
my %%info = %%$info;
|
||||
|
||||
require Module::Build; # XXX should get rid of this
|
||||
while (my ($type, $prereqs) = each %%info) {
|
||||
next if $type eq 'description' || $type eq 'recommends';
|
||||
|
||||
my %%p = %%$prereqs; # Ditto here.
|
||||
while (my ($modname, $spec) = each %%p) {
|
||||
my $status = Module::Build->check_installed_status($modname, $spec);
|
||||
if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
|
||||
if ( ! eval "require $modname; 1" ) { return 0; }
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
EOF
|
||||
|
||||
my ($module_name, $notes_name) = ($args{module}, $args{config_module});
|
||||
printf $fh <<"EOF", $notes_name, $module_name;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
$notes_name - Configuration for $module_name
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use $notes_name;
|
||||
\$value = $notes_name->config('foo');
|
||||
\$value = $notes_name->feature('bar');
|
||||
|
||||
\@names = $notes_name->config_names;
|
||||
\@names = $notes_name->feature_names;
|
||||
|
||||
$notes_name->set_config(foo => \$new_value);
|
||||
$notes_name->set_feature(bar => \$new_value);
|
||||
$notes_name->write; # Save changes
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module holds the configuration data for the C<$module_name>
|
||||
module. It also provides a programmatic interface for getting or
|
||||
setting that configuration data. Note that in order to actually make
|
||||
changes, you'll have to have write access to the C<$notes_name>
|
||||
module, and you should attempt to understand the repercussions of your
|
||||
actions.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item config(\$name)
|
||||
|
||||
Given a string argument, returns the value of the configuration item
|
||||
by that name, or C<undef> if no such item exists.
|
||||
|
||||
=item feature(\$name)
|
||||
|
||||
Given a string argument, returns the value of the feature by that
|
||||
name, or C<undef> if no such feature exists.
|
||||
|
||||
=item set_config(\$name, \$value)
|
||||
|
||||
Sets the configuration item with the given name to the given value.
|
||||
The value may be any Perl scalar that will serialize correctly using
|
||||
C<Data::Dumper>. This includes references, objects (usually), and
|
||||
complex data structures. It probably does not include transient
|
||||
things like filehandles or sockets.
|
||||
|
||||
=item set_feature(\$name, \$value)
|
||||
|
||||
Sets the feature with the given name to the given boolean value. The
|
||||
value will be converted to 0 or 1 automatically.
|
||||
|
||||
=item config_names()
|
||||
|
||||
Returns a list of all the names of config items currently defined in
|
||||
C<$notes_name>, or in scalar context the number of items.
|
||||
|
||||
=item feature_names()
|
||||
|
||||
Returns a list of all the names of features currently defined in
|
||||
C<$notes_name>, or in scalar context the number of features.
|
||||
|
||||
=item auto_feature_names()
|
||||
|
||||
Returns a list of all the names of features whose availability is
|
||||
dynamically determined, or in scalar context the number of such
|
||||
features. Does not include such features that have later been set to
|
||||
a fixed value.
|
||||
|
||||
=item write()
|
||||
|
||||
Commits any changes from C<set_config()> and C<set_feature()> to disk.
|
||||
Requires write access to the C<$notes_name> module.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
C<$notes_name> was automatically created using C<Module::Build>.
|
||||
C<Module::Build> was written by Ken Williams, but he holds no
|
||||
authorship claim or copyright claim to the contents of C<$notes_name>.
|
||||
|
||||
=cut
|
||||
|
||||
__DATA__
|
||||
|
||||
EOF
|
||||
|
||||
print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]);
|
||||
}
|
||||
|
||||
1;
|
||||
196
inc/Module-Build/Module/Build/PPMMaker.pm
Normal file
196
inc/Module-Build/Module/Build/PPMMaker.pm
Normal file
@@ -0,0 +1,196 @@
|
||||
package Module::Build::PPMMaker;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
|
||||
# few tweaks based on the PPD spec at
|
||||
# http://www.xav.com/perl/site/lib/XML/PPD.html
|
||||
|
||||
# The PPD spec is based on <http://www.w3.org/TR/NOTE-OSD>
|
||||
|
||||
sub new {
|
||||
my $package = shift;
|
||||
return bless {@_}, $package;
|
||||
}
|
||||
|
||||
sub make_ppd {
|
||||
my ($self, %args) = @_;
|
||||
my $build = delete $args{build};
|
||||
|
||||
my @codebase;
|
||||
if (exists $args{codebase}) {
|
||||
@codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase});
|
||||
} else {
|
||||
my $distfile = $build->ppm_name . '.tar.gz';
|
||||
print "Using default codebase '$distfile'\n";
|
||||
@codebase = ($distfile);
|
||||
}
|
||||
|
||||
my %dist;
|
||||
foreach my $info (qw(name author abstract version)) {
|
||||
my $method = "dist_$info";
|
||||
$dist{$info} = $build->$method() or die "Can't determine distribution's $info\n";
|
||||
}
|
||||
$dist{version} = $self->_ppd_version($dist{version});
|
||||
|
||||
$self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}};
|
||||
|
||||
# TODO: could add <LICENSE HREF=...> tag if we knew what the URLs were for
|
||||
# various licenses
|
||||
my $ppd = <<"PPD";
|
||||
<SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\">
|
||||
<TITLE>$dist{name}</TITLE>
|
||||
<ABSTRACT>$dist{abstract}</ABSTRACT>
|
||||
@{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
|
||||
<IMPLEMENTATION>
|
||||
PPD
|
||||
|
||||
# TODO: We could set <IMPLTYPE VALUE="PERL" /> or maybe
|
||||
# <IMPLTYPE VALUE="PERL/XS" /> ???
|
||||
|
||||
# We don't include recommended dependencies because PPD has no way
|
||||
# to distinguish them from normal dependencies. We don't include
|
||||
# build_requires dependencies because the PPM installer doesn't
|
||||
# build or test before installing. And obviously we don't include
|
||||
# conflicts either.
|
||||
|
||||
foreach my $type (qw(requires)) {
|
||||
my $prereq = $build->$type();
|
||||
while (my ($modname, $spec) = each %$prereq) {
|
||||
next if $modname eq 'perl';
|
||||
|
||||
my $min_version = '0.0';
|
||||
foreach my $c ($build->_parse_conditions($spec)) {
|
||||
my ($op, $version) = $c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x;
|
||||
|
||||
# This is a nasty hack because it fails if there is no >= op
|
||||
if ($op eq '>=') {
|
||||
$min_version = $version;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
# Another hack - dependencies are on modules, but PPD expects
|
||||
# them to be on distributions (I think).
|
||||
$modname =~ s/::/-/g;
|
||||
|
||||
$ppd .= sprintf(<<'EOF', $modname, $self->_ppd_version($min_version));
|
||||
<DEPENDENCY NAME="%s" VERSION="%s" />
|
||||
EOF
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
# We only include these tags if this module involves XS, on the
|
||||
# assumption that pure Perl modules will work on any OS. PERLCORE,
|
||||
# unfortunately, seems to indicate that a module works with _only_
|
||||
# that version of Perl, and so is only appropriate when a module
|
||||
# uses XS.
|
||||
if (keys %{$build->find_xs_files}) {
|
||||
my $perl_version = $self->_ppd_version($build->perl_version);
|
||||
$ppd .= sprintf(<<'EOF', $perl_version, $^O, $self->_varchname($build->config) );
|
||||
<PERLCORE VERSION="%s" />
|
||||
<OS NAME="%s" />
|
||||
<ARCHITECTURE NAME="%s" />
|
||||
EOF
|
||||
}
|
||||
|
||||
foreach my $codebase (@codebase) {
|
||||
$self->_simple_xml_escape($codebase);
|
||||
$ppd .= sprintf(<<'EOF', $codebase);
|
||||
<CODEBASE HREF="%s" />
|
||||
EOF
|
||||
}
|
||||
|
||||
$ppd .= <<'EOF';
|
||||
</IMPLEMENTATION>
|
||||
</SOFTPKG>
|
||||
EOF
|
||||
|
||||
my $ppd_file = "$dist{name}.ppd";
|
||||
my $fh = IO::File->new(">$ppd_file")
|
||||
or die "Cannot write to $ppd_file: $!";
|
||||
print $fh $ppd;
|
||||
close $fh;
|
||||
|
||||
return $ppd_file;
|
||||
}
|
||||
|
||||
sub _ppd_version {
|
||||
my ($self, $version) = @_;
|
||||
|
||||
# generates something like "0,18,0,0"
|
||||
return join ',', (split(/\./, $version), (0)x4)[0..3];
|
||||
}
|
||||
|
||||
sub _varchname { # Copied from PPM.pm
|
||||
my ($self, $config) = @_;
|
||||
my $varchname = $config->{archname};
|
||||
# Append "-5.8" to architecture name for Perl 5.8 and later
|
||||
if ($] >= 5.008) {
|
||||
my $vstring = sprintf "%vd", $^V;
|
||||
$vstring =~ s/\.\d+$//;
|
||||
$varchname .= "-$vstring";
|
||||
}
|
||||
return $varchname;
|
||||
}
|
||||
|
||||
{
|
||||
my %escapes = (
|
||||
"\n" => "\\n",
|
||||
'"' => '"',
|
||||
'&' => '&',
|
||||
'>' => '>',
|
||||
'<' => '<',
|
||||
);
|
||||
my $rx = join '|', keys %escapes;
|
||||
|
||||
sub _simple_xml_escape {
|
||||
$_[1] =~ s/($rx)/$escapes{$1}/go;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::PPMMaker - Perl Package Manager file creation
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
On the command line, builds a .ppd file:
|
||||
./Build ppd
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package contains the code that builds F<.ppd> "Perl Package
|
||||
Description" files, in support of ActiveState's "Perl Package
|
||||
Manager". Details are here:
|
||||
L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3)
|
||||
|
||||
=cut
|
||||
34
inc/Module-Build/Module/Build/Platform/Amiga.pm
Normal file
34
inc/Module-Build/Module/Build/Platform/Amiga.pm
Normal file
@@ -0,0 +1,34 @@
|
||||
package Module::Build::Platform::Amiga;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::Amiga - Builder class for Amiga platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
33
inc/Module-Build/Module/Build/Platform/Default.pm
Normal file
33
inc/Module-Build/Module/Build/Platform/Default.pm
Normal file
@@ -0,0 +1,33 @@
|
||||
package Module::Build::Platform::Default;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::Default - Stub class for unknown platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
34
inc/Module-Build/Module/Build/Platform/EBCDIC.pm
Normal file
34
inc/Module-Build/Module/Build/Platform/EBCDIC.pm
Normal file
@@ -0,0 +1,34 @@
|
||||
package Module::Build::Platform::EBCDIC;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::EBCDIC - Builder class for EBCDIC platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
34
inc/Module-Build/Module/Build/Platform/MPEiX.pm
Normal file
34
inc/Module-Build/Module/Build/Platform/MPEiX.pm
Normal file
@@ -0,0 +1,34 @@
|
||||
package Module::Build::Platform::MPEiX;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::MPEiX - Builder class for MPEiX platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
152
inc/Module-Build/Module/Build/Platform/MacOS.pm
Normal file
152
inc/Module-Build/Module/Build/Platform/MacOS.pm
Normal file
@@ -0,0 +1,152 @@
|
||||
package Module::Build::Platform::MacOS;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
use ExtUtils::Install;
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = $class->SUPER::new(@_);
|
||||
|
||||
# $Config{sitelib} and $Config{sitearch} are, unfortunately, missing.
|
||||
foreach ('sitelib', 'sitearch') {
|
||||
$self->config($_ => $self->config("install$_"))
|
||||
unless $self->config($_);
|
||||
}
|
||||
|
||||
# For some reason $Config{startperl} is filled with a bunch of crap.
|
||||
(my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//;
|
||||
$self->config(startperl => $sp);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub make_executable {
|
||||
my $self = shift;
|
||||
require MacPerl;
|
||||
foreach (@_) {
|
||||
MacPerl::SetFileInfo('McPL', 'TEXT', $_);
|
||||
}
|
||||
}
|
||||
|
||||
sub dispatch {
|
||||
my $self = shift;
|
||||
|
||||
if( !@_ and !@ARGV ) {
|
||||
require MacPerl;
|
||||
|
||||
# What comes first in the action list.
|
||||
my @action_list = qw(build test install);
|
||||
my %actions = map {+($_, 1)} $self->known_actions;
|
||||
delete @actions{@action_list};
|
||||
push @action_list, sort { $a cmp $b } keys %actions;
|
||||
|
||||
my %toolserver = map {+$_ => 1} qw(test disttest diff testdb);
|
||||
foreach (@action_list) {
|
||||
$_ .= ' *' if $toolserver{$_};
|
||||
}
|
||||
|
||||
my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list);
|
||||
return unless defined $cmd;
|
||||
$cmd =~ s/ \*$//;
|
||||
$ARGV[0] = ($cmd);
|
||||
|
||||
my $args = MacPerl::Ask('Any extra arguments? (ie. verbose=1)', '');
|
||||
return unless defined $args;
|
||||
push @ARGV, $self->split_like_shell($args);
|
||||
}
|
||||
|
||||
$self->SUPER::dispatch(@_);
|
||||
}
|
||||
|
||||
sub ACTION_realclean {
|
||||
my $self = shift;
|
||||
chmod 0666, $self->{properties}{build_script};
|
||||
$self->SUPER::ACTION_realclean;
|
||||
}
|
||||
|
||||
# ExtUtils::Install has a hard-coded '.' directory in versions less
|
||||
# than 1.30. We use a sneaky trick to turn that into ':'.
|
||||
#
|
||||
# Note that we do it here in a cross-platform way, so this code could
|
||||
# actually go in Module::Build::Base. But we put it here to be less
|
||||
# intrusive for other platforms.
|
||||
|
||||
sub ACTION_install {
|
||||
my $self = shift;
|
||||
|
||||
return $self->SUPER::ACTION_install(@_)
|
||||
if eval {ExtUtils::Install->VERSION('1.30'); 1};
|
||||
|
||||
local $^W = 0; # Avoid a 'redefine' warning
|
||||
local *ExtUtils::Install::find = sub {
|
||||
my ($code, @dirs) = @_;
|
||||
|
||||
@dirs = map { $_ eq '.' ? File::Spec->curdir : $_ } @dirs;
|
||||
|
||||
return File::Find::find($code, @dirs);
|
||||
};
|
||||
|
||||
return $self->SUPER::ACTION_install(@_);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::MacOS - Builder class for MacOS platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base> and override a few methods. Please see
|
||||
L<Module::Build> for the docs.
|
||||
|
||||
=head2 Overridden Methods
|
||||
|
||||
=over 4
|
||||
|
||||
=item new()
|
||||
|
||||
MacPerl doesn't define $Config{sitelib} or $Config{sitearch} for some
|
||||
reason, but $Config{installsitelib} and $Config{installsitearch} are
|
||||
there. So we copy the install variables to the other location
|
||||
|
||||
=item make_executable()
|
||||
|
||||
On MacOS we set the file type and creator to MacPerl so it will run
|
||||
with a double-click.
|
||||
|
||||
=item dispatch()
|
||||
|
||||
Because there's no easy way to say "./Build test" on MacOS, if
|
||||
dispatch is called with no arguments and no @ARGV a dialog box will
|
||||
pop up asking what action to take and any extra arguments.
|
||||
|
||||
Default action is "test".
|
||||
|
||||
=item ACTION_realclean()
|
||||
|
||||
Need to unlock the Build program before deleting.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Michael G Schwern <schwern@pobox.com>
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
34
inc/Module-Build/Module/Build/Platform/RiscOS.pm
Normal file
34
inc/Module-Build/Module/Build/Platform/RiscOS.pm
Normal file
@@ -0,0 +1,34 @@
|
||||
package Module::Build::Platform::RiscOS;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::RiscOS - Builder class for RiscOS platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
73
inc/Module-Build/Module/Build/Platform/Unix.pm
Normal file
73
inc/Module-Build/Module/Build/Platform/Unix.pm
Normal file
@@ -0,0 +1,73 @@
|
||||
package Module::Build::Platform::Unix;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
sub is_executable {
|
||||
# We consider the owner bit to be authoritative on a file, because
|
||||
# -x will always return true if the user is root and *any*
|
||||
# executable bit is set. The -x test seems to try to answer the
|
||||
# question "can I execute this file", but I think we want "is this
|
||||
# file executable".
|
||||
|
||||
my ($self, $file) = @_;
|
||||
return +(stat $file)[2] & 0100;
|
||||
}
|
||||
|
||||
sub _startperl { "#! " . shift()->perl }
|
||||
|
||||
sub _construct {
|
||||
my $self = shift()->SUPER::_construct(@_);
|
||||
|
||||
# perl 5.8.1-RC[1-3] had some broken %Config entries, and
|
||||
# unfortunately Red Hat 9 shipped it like that. Fix 'em up here.
|
||||
my $c = $self->{config};
|
||||
for (qw(siteman1 siteman3 vendorman1 vendorman3)) {
|
||||
$c->{"install${_}dir"} ||= $c->{"install${_}"};
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Open group says username should be portable filename characters,
|
||||
# but some Unix OS working with ActiveDirectory wind up with user-names
|
||||
# with back-slashes in the name. The new code below is very liberal
|
||||
# in what it accepts.
|
||||
sub _detildefy {
|
||||
my ($self, $value) = @_;
|
||||
$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username
|
||||
[$1 ?
|
||||
((getpwnam $1)[7] || "~$1") :
|
||||
($ENV{HOME} || (getpwuid $>)[7])
|
||||
]ex;
|
||||
return $value;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::Unix - Builder class for Unix platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
482
inc/Module-Build/Module/Build/Platform/VMS.pm
Normal file
482
inc/Module-Build/Module/Build/Platform/VMS.pm
Normal file
@@ -0,0 +1,482 @@
|
||||
package Module::Build::Platform::VMS;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::VMS - Builder class for VMS platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module inherits from C<Module::Build::Base> and alters a few
|
||||
minor details of its functionality. Please see L<Module::Build> for
|
||||
the general docs.
|
||||
|
||||
=head2 Overridden Methods
|
||||
|
||||
=over 4
|
||||
|
||||
=item _set_defaults
|
||||
|
||||
Change $self->{build_script} to 'Build.com' so @Build works.
|
||||
|
||||
=cut
|
||||
|
||||
sub _set_defaults {
|
||||
my $self = shift;
|
||||
$self->SUPER::_set_defaults(@_);
|
||||
|
||||
$self->{properties}{build_script} = 'Build.com';
|
||||
}
|
||||
|
||||
|
||||
=item cull_args
|
||||
|
||||
'@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing
|
||||
people to write '@Build "foo"' we'll dispatch case-insensitively.
|
||||
|
||||
=cut
|
||||
|
||||
sub cull_args {
|
||||
my $self = shift;
|
||||
my($action, $args) = $self->SUPER::cull_args(@_);
|
||||
my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;
|
||||
|
||||
die "Ambiguous action '$action'. Could be one of @possible_actions"
|
||||
if @possible_actions > 1;
|
||||
|
||||
return ($possible_actions[0], $args);
|
||||
}
|
||||
|
||||
|
||||
=item manpage_separator
|
||||
|
||||
Use '__' instead of '::'.
|
||||
|
||||
=cut
|
||||
|
||||
sub manpage_separator {
|
||||
return '__';
|
||||
}
|
||||
|
||||
|
||||
=item prefixify
|
||||
|
||||
Prefixify taking into account VMS' filepath syntax.
|
||||
|
||||
=cut
|
||||
|
||||
# Translated from ExtUtils::MM_VMS::prefixify()
|
||||
sub _prefixify {
|
||||
my($self, $path, $sprefix, $type) = @_;
|
||||
my $rprefix = $self->prefix;
|
||||
|
||||
$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
|
||||
|
||||
# Translate $(PERLPREFIX) to a real path.
|
||||
$rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
|
||||
$sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
|
||||
|
||||
$self->log_verbose(" rprefix translated to $rprefix\n".
|
||||
" sprefix translated to $sprefix\n");
|
||||
|
||||
if( length $path == 0 ) {
|
||||
$self->log_verbose(" no path to prefixify.\n")
|
||||
}
|
||||
elsif( !File::Spec->file_name_is_absolute($path) ) {
|
||||
$self->log_verbose(" path is relative, not prefixifying.\n");
|
||||
}
|
||||
elsif( $sprefix eq $rprefix ) {
|
||||
$self->log_verbose(" no new prefix.\n");
|
||||
}
|
||||
else {
|
||||
my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
|
||||
my $vms_prefix = $self->config('vms_prefix');
|
||||
if( $path_vol eq $vms_prefix.':' ) {
|
||||
$self->log_verbose(" $vms_prefix: seen\n");
|
||||
|
||||
$path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
|
||||
$path = $self->_catprefix($rprefix, $path_dirs);
|
||||
}
|
||||
else {
|
||||
$self->log_verbose(" cannot prefixify.\n");
|
||||
return $self->prefix_relpaths($self->installdirs, $type);
|
||||
}
|
||||
}
|
||||
|
||||
$self->log_verbose(" now $path\n");
|
||||
|
||||
return $path;
|
||||
}
|
||||
|
||||
=item _quote_args
|
||||
|
||||
Command-line arguments (but not the command itself) must be quoted
|
||||
to ensure case preservation.
|
||||
|
||||
=cut
|
||||
|
||||
sub _quote_args {
|
||||
# Returns a string that can become [part of] a command line with
|
||||
# proper quoting so that the subprocess sees this same list of args,
|
||||
# or if we get a single arg that is an array reference, quote the
|
||||
# elements of it and return the reference.
|
||||
my ($self, @args) = @_;
|
||||
my $got_arrayref = (scalar(@args) == 1
|
||||
&& UNIVERSAL::isa($args[0], 'ARRAY'))
|
||||
? 1
|
||||
: 0;
|
||||
|
||||
# Do not quote qualifiers that begin with '/'.
|
||||
map { if (!/^\//) {
|
||||
$_ =~ s/\"/""/g; # escape C<"> by doubling
|
||||
$_ = q(").$_.q(");
|
||||
}
|
||||
}
|
||||
($got_arrayref ? @{$args[0]}
|
||||
: @args
|
||||
);
|
||||
|
||||
return $got_arrayref ? $args[0]
|
||||
: join(' ', @args);
|
||||
}
|
||||
|
||||
=item have_forkpipe
|
||||
|
||||
There is no native fork(), so some constructs depending on it are not
|
||||
available.
|
||||
|
||||
=cut
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
=item _backticks
|
||||
|
||||
Override to ensure that we quote the arguments but not the command.
|
||||
|
||||
=cut
|
||||
|
||||
sub _backticks {
|
||||
# The command must not be quoted but the arguments to it must be.
|
||||
my ($self, @cmd) = @_;
|
||||
my $cmd = shift @cmd;
|
||||
my $args = $self->_quote_args(@cmd);
|
||||
return `$cmd $args`;
|
||||
}
|
||||
|
||||
=item do_system
|
||||
|
||||
Override to ensure that we quote the arguments but not the command.
|
||||
|
||||
=cut
|
||||
|
||||
sub do_system {
|
||||
# The command must not be quoted but the arguments to it must be.
|
||||
my ($self, @cmd) = @_;
|
||||
$self->log_info("@cmd\n");
|
||||
my $cmd = shift @cmd;
|
||||
my $args = $self->_quote_args(@cmd);
|
||||
return !system("$cmd $args");
|
||||
}
|
||||
|
||||
=item oneliner
|
||||
|
||||
Override to ensure that we do not quote the command.
|
||||
|
||||
=cut
|
||||
|
||||
sub oneliner {
|
||||
my $self = shift;
|
||||
my $oneliner = $self->SUPER::oneliner(@_);
|
||||
|
||||
$oneliner =~ s/^\"\S+\"//;
|
||||
|
||||
return "MCR $^X $oneliner";
|
||||
}
|
||||
|
||||
=item _infer_xs_spec
|
||||
|
||||
Inherit the standard version but tweak the library file name to be
|
||||
something Dynaloader can find.
|
||||
|
||||
=cut
|
||||
|
||||
sub _infer_xs_spec {
|
||||
my $self = shift;
|
||||
my $file = shift;
|
||||
|
||||
my $spec = $self->SUPER::_infer_xs_spec($file);
|
||||
|
||||
# Need to create with the same name as DynaLoader will load with.
|
||||
if (defined &DynaLoader::mod2fname) {
|
||||
my $file = $$spec{module_name} . '.' . $self->{config}->get('dlext');
|
||||
$file =~ tr/:/_/;
|
||||
$file = DynaLoader::mod2fname([$file]);
|
||||
$$spec{lib_file} = File::Spec->catfile($$spec{archdir}, $file);
|
||||
}
|
||||
|
||||
return $spec;
|
||||
}
|
||||
|
||||
=item rscan_dir
|
||||
|
||||
Inherit the standard version but remove dots at end of name.
|
||||
If the extended character set is in effect, do not remove dots from filenames
|
||||
with Unix path delimiters.
|
||||
|
||||
=cut
|
||||
|
||||
sub rscan_dir {
|
||||
my ($self, $dir, $pattern) = @_;
|
||||
|
||||
my $result = $self->SUPER::rscan_dir( $dir, $pattern );
|
||||
|
||||
for my $file (@$result) {
|
||||
if (!_efs() && ($file =~ m#/#)) {
|
||||
$file =~ s/\.$//;
|
||||
}
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
|
||||
=item dist_dir
|
||||
|
||||
Inherit the standard version but replace embedded dots with underscores because
|
||||
a dot is the directory delimiter on VMS.
|
||||
|
||||
=cut
|
||||
|
||||
sub dist_dir {
|
||||
my $self = shift;
|
||||
|
||||
my $dist_dir = $self->SUPER::dist_dir;
|
||||
$dist_dir =~ s/\./_/g unless _efs();
|
||||
return $dist_dir;
|
||||
}
|
||||
|
||||
=item man3page_name
|
||||
|
||||
Inherit the standard version but chop the extra manpage delimiter off the front if
|
||||
there is one. The VMS version of splitdir('[.foo]') returns '', 'foo'.
|
||||
|
||||
=cut
|
||||
|
||||
sub man3page_name {
|
||||
my $self = shift;
|
||||
|
||||
my $mpname = $self->SUPER::man3page_name( shift );
|
||||
my $sep = $self->manpage_separator;
|
||||
$mpname =~ s/^$sep//;
|
||||
return $mpname;
|
||||
}
|
||||
|
||||
=item expand_test_dir
|
||||
|
||||
Inherit the standard version but relativize the paths as the native glob() doesn't
|
||||
do that for us.
|
||||
|
||||
=cut
|
||||
|
||||
sub expand_test_dir {
|
||||
my ($self, $dir) = @_;
|
||||
|
||||
my @reldirs = $self->SUPER::expand_test_dir( $dir );
|
||||
|
||||
for my $eachdir (@reldirs) {
|
||||
my ($v,$d,$f) = File::Spec->splitpath( $eachdir );
|
||||
my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) );
|
||||
$eachdir = File::Spec->catfile( $reldir, $f );
|
||||
}
|
||||
return @reldirs;
|
||||
}
|
||||
|
||||
=item _detildefy
|
||||
|
||||
The home-grown glob() does not currently handle tildes, so provide limited support
|
||||
here. Expect only UNIX format file specifications for now.
|
||||
|
||||
=cut
|
||||
|
||||
sub _detildefy {
|
||||
my ($self, $arg) = @_;
|
||||
|
||||
# Apparently double ~ are not translated.
|
||||
return $arg if ($arg =~ /^~~/);
|
||||
|
||||
# Apparently ~ followed by whitespace are not translated.
|
||||
return $arg if ($arg =~ /^~ /);
|
||||
|
||||
if ($arg =~ /^~/) {
|
||||
my $spec = $arg;
|
||||
|
||||
# Remove the tilde
|
||||
$spec =~ s/^~//;
|
||||
|
||||
# Remove any slash following the tilde if present.
|
||||
$spec =~ s#^/##;
|
||||
|
||||
# break up the paths for the merge
|
||||
my $home = VMS::Filespec::unixify($ENV{HOME});
|
||||
|
||||
# In the default VMS mode, the trailing slash is present.
|
||||
# In Unix report mode it is not. The parsing logic assumes that
|
||||
# it is present.
|
||||
$home .= '/' unless $home =~ m#/$#;
|
||||
|
||||
# Trivial case of just ~ by it self
|
||||
if ($spec eq '') {
|
||||
$home =~ s#/$##;
|
||||
return $home;
|
||||
}
|
||||
|
||||
my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
|
||||
if ($hdir eq '') {
|
||||
# Someone has tampered with $ENV{HOME}
|
||||
# So hfile is probably the directory since this should be
|
||||
# a path.
|
||||
$hdir = $hfile;
|
||||
}
|
||||
|
||||
my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
|
||||
|
||||
my @hdirs = File::Spec::Unix->splitdir($hdir);
|
||||
my @dirs = File::Spec::Unix->splitdir($dir);
|
||||
|
||||
my $newdirs;
|
||||
|
||||
# Two cases of tilde handling
|
||||
if ($arg =~ m#^~/#) {
|
||||
|
||||
# Simple case, just merge together
|
||||
$newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
|
||||
|
||||
} else {
|
||||
|
||||
# Complex case, need to add an updir - No delimiters
|
||||
my @backup = File::Spec::Unix->splitdir(File::Spec::Unix->updir);
|
||||
|
||||
$newdirs = File::Spec::Unix->catdir(@hdirs, @backup, @dirs);
|
||||
|
||||
}
|
||||
|
||||
# Now put the two cases back together
|
||||
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
|
||||
|
||||
}
|
||||
return $arg;
|
||||
|
||||
}
|
||||
|
||||
=item find_perl_interpreter
|
||||
|
||||
On VMS, $^X returns the fully qualified absolute path including version
|
||||
number. It's logically impossible to improve on it for getting the perl
|
||||
we're currently running, and attempting to manipulate it is usually
|
||||
lossy.
|
||||
|
||||
=cut
|
||||
|
||||
sub find_perl_interpreter {
|
||||
return VMS::Filespec::vmsify($^X);
|
||||
}
|
||||
|
||||
=item localize_file_path
|
||||
|
||||
Convert the file path to the local syntax
|
||||
|
||||
=cut
|
||||
|
||||
sub localize_file_path {
|
||||
my ($self, $path) = @_;
|
||||
$path = VMS::Filespec::vmsify($path);
|
||||
$path =~ s/\.\z//;
|
||||
return $path;
|
||||
}
|
||||
|
||||
=item localize_dir_path
|
||||
|
||||
Convert the directory path to the local syntax
|
||||
|
||||
=cut
|
||||
|
||||
sub localize_dir_path {
|
||||
my ($self, $path) = @_;
|
||||
return VMS::Filespec::vmspath($path);
|
||||
}
|
||||
|
||||
=item ACTION_clean
|
||||
|
||||
The home-grown glob() expands a bit too aggressively when given a bare name,
|
||||
so default in a zero-length extension.
|
||||
|
||||
=cut
|
||||
|
||||
sub ACTION_clean {
|
||||
my ($self) = @_;
|
||||
foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) {
|
||||
$self->delete_filetree($item);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Need to look up the feature settings. The preferred way is to use the
|
||||
# VMS::Feature module, but that may not be available to dual life modules.
|
||||
|
||||
my $use_feature;
|
||||
BEGIN {
|
||||
if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
|
||||
$use_feature = 1;
|
||||
}
|
||||
}
|
||||
|
||||
# Need to look up the UNIX report mode. This may become a dynamic mode
|
||||
# in the future.
|
||||
sub _unix_rpt {
|
||||
my $unix_rpt;
|
||||
if ($use_feature) {
|
||||
$unix_rpt = VMS::Feature::current("filename_unix_report");
|
||||
} else {
|
||||
my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
|
||||
$unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
|
||||
}
|
||||
return $unix_rpt;
|
||||
}
|
||||
|
||||
# Need to look up the EFS character set mode. This may become a dynamic
|
||||
# mode in the future.
|
||||
sub _efs {
|
||||
my $efs;
|
||||
if ($use_feature) {
|
||||
$efs = VMS::Feature::current("efs_charset");
|
||||
} else {
|
||||
my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
|
||||
$efs = $env_efs =~ /^[ET1]/i;
|
||||
}
|
||||
return $efs;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Michael G Schwern <schwern@pobox.com>
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
Craig A. Berry <craigberry@mac.com>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
__END__
|
||||
34
inc/Module-Build/Module/Build/Platform/VOS.pm
Normal file
34
inc/Module-Build/Module/Build/Platform/VOS.pm
Normal file
@@ -0,0 +1,34 @@
|
||||
package Module::Build::Platform::VOS;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::VOS - Builder class for VOS platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
299
inc/Module-Build/Module/Build/Platform/Windows.pm
Normal file
299
inc/Module-Build/Module/Build/Platform/Windows.pm
Normal file
@@ -0,0 +1,299 @@
|
||||
package Module::Build::Platform::Windows;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
use Config;
|
||||
use File::Basename;
|
||||
use File::Spec;
|
||||
use IO::File;
|
||||
|
||||
use Module::Build::Base;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
sub manpage_separator {
|
||||
return '.';
|
||||
}
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
sub _detildefy {
|
||||
my ($self, $value) = @_;
|
||||
$value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x
|
||||
if $ENV{HOME};
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub ACTION_realclean {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->SUPER::ACTION_realclean();
|
||||
|
||||
my $basename = basename($0);
|
||||
$basename =~ s/(?:\.bat)?$//i;
|
||||
|
||||
if ( lc $basename eq lc $self->build_script ) {
|
||||
if ( $self->build_bat ) {
|
||||
$self->log_info("Deleting $basename.bat\n");
|
||||
my $full_progname = $0;
|
||||
$full_progname =~ s/(?:\.bat)?$/.bat/i;
|
||||
|
||||
# Voodoo required to have a batch file delete itself without error;
|
||||
# Syntax differs between 9x & NT: the later requires a null arg (???)
|
||||
require Win32;
|
||||
my $null_arg = (Win32::IsWinNT()) ? '""' : '';
|
||||
my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");
|
||||
|
||||
my $fh = IO::File->new(">> $basename.bat")
|
||||
or die "Can't create $basename.bat: $!";
|
||||
print $fh $cmd;
|
||||
close $fh ;
|
||||
} else {
|
||||
$self->delete_filetree($self->build_script . '.bat');
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub make_executable {
|
||||
my $self = shift;
|
||||
|
||||
$self->SUPER::make_executable(@_);
|
||||
|
||||
foreach my $script (@_) {
|
||||
|
||||
# Native batch script
|
||||
if ( $script =~ /\.(bat|cmd)$/ ) {
|
||||
$self->SUPER::make_executable($script);
|
||||
next;
|
||||
|
||||
# Perl script that needs to be wrapped in a batch script
|
||||
} else {
|
||||
my %opts = ();
|
||||
if ( $script eq $self->build_script ) {
|
||||
$opts{ntargs} = q(-x -S %0 --build_bat %*);
|
||||
$opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9);
|
||||
}
|
||||
|
||||
my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)};
|
||||
if ( $@ ) {
|
||||
$self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@");
|
||||
} else {
|
||||
$self->SUPER::make_executable($out);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# This routine was copied almost verbatim from the 'pl2bat' utility
|
||||
# distributed with perl. It requires too much voodoo with shell quoting
|
||||
# differences and shortcomings between the various flavors of Windows
|
||||
# to reliably shell out
|
||||
sub pl2bat {
|
||||
my $self = shift;
|
||||
my %opts = @_;
|
||||
|
||||
# NOTE: %0 is already enclosed in doublequotes by cmd.exe, as appropriate
|
||||
$opts{ntargs} = '-x -S %0 %*' unless exists $opts{ntargs};
|
||||
$opts{otherargs} = '-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists $opts{otherargs};
|
||||
|
||||
$opts{stripsuffix} = '/\\.plx?/' unless exists $opts{stripsuffix};
|
||||
$opts{stripsuffix} = ($opts{stripsuffix} =~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E");
|
||||
|
||||
unless (exists $opts{out}) {
|
||||
$opts{out} = $opts{in};
|
||||
$opts{out} =~ s/$opts{stripsuffix}$//oi;
|
||||
$opts{out} .= '.bat' unless $opts{in} =~ /\.bat$/i or $opts{in} =~ /^-$/;
|
||||
}
|
||||
|
||||
my $head = <<EOT;
|
||||
\@rem = '--*-Perl-*--
|
||||
\@echo off
|
||||
if "%OS%" == "Windows_NT" goto WinNT
|
||||
perl $opts{otherargs}
|
||||
goto endofperl
|
||||
:WinNT
|
||||
perl $opts{ntargs}
|
||||
if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
|
||||
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
|
||||
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
|
||||
goto endofperl
|
||||
\@rem ';
|
||||
EOT
|
||||
|
||||
$head =~ s/^\s+//gm;
|
||||
my $headlines = 2 + ($head =~ tr/\n/\n/);
|
||||
my $tail = "\n__END__\n:endofperl\n";
|
||||
|
||||
my $linedone = 0;
|
||||
my $taildone = 0;
|
||||
my $linenum = 0;
|
||||
my $skiplines = 0;
|
||||
|
||||
my $start = $Config{startperl};
|
||||
$start = "#!perl" unless $start =~ /^#!.*perl/;
|
||||
|
||||
my $in = IO::File->new("< $opts{in}") or die "Can't open $opts{in}: $!";
|
||||
my @file = <$in>;
|
||||
$in->close;
|
||||
|
||||
foreach my $line ( @file ) {
|
||||
$linenum++;
|
||||
if ( $line =~ /^:endofperl\b/ ) {
|
||||
if (!exists $opts{update}) {
|
||||
warn "$opts{in} has already been converted to a batch file!\n";
|
||||
return;
|
||||
}
|
||||
$taildone++;
|
||||
}
|
||||
if ( not $linedone and $line =~ /^#!.*perl/ ) {
|
||||
if (exists $opts{update}) {
|
||||
$skiplines = $linenum - 1;
|
||||
$line .= "#line ".(1+$headlines)."\n";
|
||||
} else {
|
||||
$line .= "#line ".($linenum+$headlines)."\n";
|
||||
}
|
||||
$linedone++;
|
||||
}
|
||||
if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
|
||||
$line = "";
|
||||
}
|
||||
}
|
||||
|
||||
my $out = IO::File->new("> $opts{out}") or die "Can't open $opts{out}: $!";
|
||||
print $out $head;
|
||||
print $out $start, ( $opts{usewarnings} ? " -w" : "" ),
|
||||
"\n#line ", ($headlines+1), "\n" unless $linedone;
|
||||
print $out @file[$skiplines..$#file];
|
||||
print $out $tail unless $taildone;
|
||||
$out->close;
|
||||
|
||||
return $opts{out};
|
||||
}
|
||||
|
||||
|
||||
sub _quote_args {
|
||||
# Returns a string that can become [part of] a command line with
|
||||
# proper quoting so that the subprocess sees this same list of args.
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my @quoted;
|
||||
|
||||
for (@args) {
|
||||
if ( /^[^\s*?!\$<>;|'"\[\]\{\}]+$/ ) {
|
||||
# Looks pretty safe
|
||||
push @quoted, $_;
|
||||
} else {
|
||||
# XXX this will obviously have to improve - is there already a
|
||||
# core module lying around that does proper quoting?
|
||||
s/"/\\"/g;
|
||||
push @quoted, qq("$_");
|
||||
}
|
||||
}
|
||||
|
||||
return join " ", @quoted;
|
||||
}
|
||||
|
||||
|
||||
sub split_like_shell {
|
||||
# As it turns out, Windows command-parsing is very different from
|
||||
# Unix command-parsing. Double-quotes mean different things,
|
||||
# backslashes don't necessarily mean escapes, and so on. So we
|
||||
# can't use Text::ParseWords::shellwords() to break a command string
|
||||
# into words. The algorithm below was bashed out by Randy and Ken
|
||||
# (mostly Randy), and there are a lot of regression tests, so we
|
||||
# should feel free to adjust if desired.
|
||||
|
||||
(my $self, local $_) = @_;
|
||||
|
||||
return @$_ if defined() && UNIVERSAL::isa($_, 'ARRAY');
|
||||
|
||||
my @argv;
|
||||
return @argv unless defined() && length();
|
||||
|
||||
my $arg = '';
|
||||
my( $i, $quote_mode ) = ( 0, 0 );
|
||||
|
||||
while ( $i < length() ) {
|
||||
|
||||
my $ch = substr( $_, $i , 1 );
|
||||
my $next_ch = substr( $_, $i+1, 1 );
|
||||
|
||||
if ( $ch eq '\\' && $next_ch eq '"' ) {
|
||||
$arg .= '"';
|
||||
$i++;
|
||||
} elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
|
||||
$arg .= '\\';
|
||||
$i++;
|
||||
} elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
|
||||
$quote_mode = !$quote_mode;
|
||||
$arg .= '"';
|
||||
$i++;
|
||||
} elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
|
||||
( $i + 2 == length() ||
|
||||
substr( $_, $i + 2, 1 ) eq ' ' )
|
||||
) { # for cases like: a"" => [ 'a' ]
|
||||
push( @argv, $arg );
|
||||
$arg = '';
|
||||
$i += 2;
|
||||
} elsif ( $ch eq '"' ) {
|
||||
$quote_mode = !$quote_mode;
|
||||
} elsif ( $ch eq ' ' && !$quote_mode ) {
|
||||
push( @argv, $arg ) if $arg;
|
||||
$arg = '';
|
||||
++$i while substr( $_, $i + 1, 1 ) eq ' ';
|
||||
} else {
|
||||
$arg .= $ch;
|
||||
}
|
||||
|
||||
$i++;
|
||||
}
|
||||
|
||||
push( @argv, $arg ) if defined( $arg ) && length( $arg );
|
||||
return @argv;
|
||||
}
|
||||
|
||||
|
||||
# system(@cmd) does not like having double-quotes in it on Windows.
|
||||
# So we quote them and run it as a single command.
|
||||
sub do_system {
|
||||
my ($self, @cmd) = @_;
|
||||
|
||||
my $cmd = $self->_quote_args(@cmd);
|
||||
my $status = system($cmd);
|
||||
if ($status and $! =~ /Argument list too long/i) {
|
||||
my $env_entries = '';
|
||||
foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " }
|
||||
warn "'Argument list' was 'too long', env lengths are $env_entries";
|
||||
}
|
||||
return !$status;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::Windows - Builder class for Windows platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base> and override a few methods. Please see
|
||||
L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3)
|
||||
|
||||
=cut
|
||||
40
inc/Module-Build/Module/Build/Platform/aix.pm
Normal file
40
inc/Module-Build/Module/Build/Platform/aix.pm
Normal file
@@ -0,0 +1,40 @@
|
||||
package Module::Build::Platform::aix;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
# This class isn't necessary anymore, but we can't delete it, because
|
||||
# some people might still have the old copy in their @INC, containing
|
||||
# code we don't want to execute, so we have to make sure an upgrade
|
||||
# will replace it with this empty subclass.
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::aix - Builder class for AIX platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the AIX
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
39
inc/Module-Build/Module/Build/Platform/cygwin.pm
Normal file
39
inc/Module-Build/Module/Build/Platform/cygwin.pm
Normal file
@@ -0,0 +1,39 @@
|
||||
package Module::Build::Platform::cygwin;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
sub manpage_separator {
|
||||
'.'
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::cygwin - Builder class for Cygwin platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the cygwin
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Initial stub by Yitzchak Scott-Thoennes <sthoenna@efn.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
40
inc/Module-Build/Module/Build/Platform/darwin.pm
Normal file
40
inc/Module-Build/Module/Build/Platform/darwin.pm
Normal file
@@ -0,0 +1,40 @@
|
||||
package Module::Build::Platform::darwin;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
# This class isn't necessary anymore, but we can't delete it, because
|
||||
# some people might still have the old copy in their @INC, containing
|
||||
# code we don't want to execute, so we have to make sure an upgrade
|
||||
# will replace it with this empty subclass.
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::darwin - Builder class for Mac OS X platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the Mac OS X
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
39
inc/Module-Build/Module/Build/Platform/os2.pm
Normal file
39
inc/Module-Build/Module/Build/Platform/os2.pm
Normal file
@@ -0,0 +1,39 @@
|
||||
package Module::Build::Platform::os2;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
sub manpage_separator { '.' }
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::os2 - Builder class for OS/2 platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the OS/2
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
106
inc/Module-Build/Module/Build/PodParser.pm
Normal file
106
inc/Module-Build/Module/Build/PodParser.pm
Normal file
@@ -0,0 +1,106 @@
|
||||
package Module::Build::PodParser;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION);
|
||||
$VERSION = '0.34';
|
||||
$VERSION = eval $VERSION;
|
||||
use vars qw(@ISA);
|
||||
|
||||
sub new {
|
||||
# Perl is so fun.
|
||||
my $package = shift;
|
||||
|
||||
my $self;
|
||||
|
||||
# Try using Pod::Parser first
|
||||
if (eval{ require Pod::Parser; 1; }) {
|
||||
@ISA = qw(Pod::Parser);
|
||||
$self = $package->SUPER::new(@_);
|
||||
$self->{have_pod_parser} = 1;
|
||||
} else {
|
||||
@ISA = ();
|
||||
*parse_from_filehandle = \&_myparse_from_filehandle;
|
||||
$self = bless {have_pod_parser => 0, @_}, $package;
|
||||
}
|
||||
|
||||
unless ($self->{fh}) {
|
||||
die "No 'file' or 'fh' parameter given" unless $self->{file};
|
||||
$self->{fh} = IO::File->new($self->{file}) or die "Couldn't open $self->{file}: $!";
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub _myparse_from_filehandle {
|
||||
my ($self, $fh) = @_;
|
||||
|
||||
local $_;
|
||||
while (<$fh>) {
|
||||
next unless /^=(?!cut)/ .. /^=cut/; # in POD
|
||||
last if ($self->{abstract}) = /^ (?: [a-z:]+ \s+ - \s+ ) (.*\S) /ix;
|
||||
}
|
||||
|
||||
my @author;
|
||||
while (<$fh>) {
|
||||
next unless /^=head1\s+AUTHORS?/ ... /^=/;
|
||||
next if /^=/;
|
||||
push @author, $_ if /\@/;
|
||||
}
|
||||
return unless @author;
|
||||
s/^\s+|\s+$//g foreach @author;
|
||||
|
||||
$self->{author} = \@author;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub get_abstract {
|
||||
my $self = shift;
|
||||
return $self->{abstract} if defined $self->{abstract};
|
||||
|
||||
$self->parse_from_filehandle($self->{fh});
|
||||
|
||||
return $self->{abstract};
|
||||
}
|
||||
|
||||
sub get_author {
|
||||
my $self = shift;
|
||||
return $self->{author} if defined $self->{author};
|
||||
|
||||
$self->parse_from_filehandle($self->{fh});
|
||||
|
||||
return $self->{author} || [];
|
||||
}
|
||||
|
||||
################## Pod::Parser overrides ###########
|
||||
sub initialize {
|
||||
my $self = shift;
|
||||
$self->{_head} = '';
|
||||
$self->SUPER::initialize();
|
||||
}
|
||||
|
||||
sub command {
|
||||
my ($self, $cmd, $text) = @_;
|
||||
if ( $cmd eq 'head1' ) {
|
||||
$text =~ s/^\s+//;
|
||||
$text =~ s/\s+$//;
|
||||
$self->{_head} = $text;
|
||||
}
|
||||
}
|
||||
|
||||
sub textblock {
|
||||
my ($self, $text) = @_;
|
||||
$text =~ s/^\s+//;
|
||||
$text =~ s/\s+$//;
|
||||
if ($self->{_head} eq 'NAME') {
|
||||
my ($name, $abstract) = split( /\s+-\s+/, $text, 2 );
|
||||
$self->{abstract} = $abstract;
|
||||
} elsif ($self->{_head} =~ /^AUTHORS?$/) {
|
||||
push @{$self->{author}}, $text if $text =~ /\@/;
|
||||
}
|
||||
}
|
||||
|
||||
sub verbatim {}
|
||||
sub interior_sequence {}
|
||||
|
||||
1;
|
||||
686
inc/Module-Build/Module/Build/Version.pm
Normal file
686
inc/Module-Build/Module/Build/Version.pm
Normal file
@@ -0,0 +1,686 @@
|
||||
package Module::Build::Version;
|
||||
use strict;
|
||||
|
||||
use vars qw($VERSION);
|
||||
$VERSION = 0.77;
|
||||
|
||||
eval "use version $VERSION";
|
||||
if ($@) { # can't locate version files, use our own
|
||||
|
||||
# Avoid redefined warnings if an old version.pm was available
|
||||
delete $version::{$_} foreach keys %version::;
|
||||
|
||||
# first we get the stub version module
|
||||
my $version;
|
||||
while (<DATA>) {
|
||||
s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
|
||||
$version .= $_ if $_;
|
||||
last if /^1;$/;
|
||||
}
|
||||
|
||||
# and now get the current version::vpp code
|
||||
my $vpp;
|
||||
while (<DATA>) {
|
||||
s/(\$VERSION)\s=\s\d+/\$VERSION = 0/;
|
||||
$vpp .= $_ if $_;
|
||||
last if /^1;$/;
|
||||
}
|
||||
|
||||
# but we eval them in reverse order since version depends on
|
||||
# version::vpp to already exist
|
||||
eval $vpp; die $@ if $@;
|
||||
$INC{'version/vpp.pm'} = 'inside Module::Build::Version';
|
||||
eval $version; die $@ if $@;
|
||||
$INC{'version.pm'} = 'inside Module::Build::Version';
|
||||
}
|
||||
|
||||
# now we can safely subclass version, installed or not
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(version);
|
||||
|
||||
1;
|
||||
__DATA__
|
||||
# stub version module to make everything else happy
|
||||
package version;
|
||||
|
||||
use 5.005_04;
|
||||
use strict;
|
||||
|
||||
use vars qw(@ISA $VERSION $CLASS *declare *qv);
|
||||
|
||||
$VERSION = 0.77;
|
||||
|
||||
$CLASS = 'version';
|
||||
|
||||
push @ISA, "version::vpp";
|
||||
local $^W;
|
||||
*version::qv = \&version::vpp::qv;
|
||||
*version::declare = \&version::vpp::declare;
|
||||
*version::_VERSION = \&version::vpp::_VERSION;
|
||||
if ($] > 5.009001 && $] <= 5.010000) {
|
||||
no strict 'refs';
|
||||
*{'version::stringify'} = \*version::vpp::stringify;
|
||||
*{'version::(""'} = \*version::vpp::stringify;
|
||||
*{'version::new'} = \*version::vpp::new;
|
||||
}
|
||||
|
||||
# Preloaded methods go here.
|
||||
sub import {
|
||||
no strict 'refs';
|
||||
my ($class) = shift;
|
||||
|
||||
# Set up any derived class
|
||||
unless ($class eq 'version') {
|
||||
local $^W;
|
||||
*{$class.'::declare'} = \&version::declare;
|
||||
*{$class.'::qv'} = \&version::qv;
|
||||
}
|
||||
|
||||
my %args;
|
||||
if (@_) { # any remaining terms are arguments
|
||||
map { $args{$_} = 1 } @_
|
||||
}
|
||||
else { # no parameters at all on use line
|
||||
%args =
|
||||
(
|
||||
qv => 1,
|
||||
'UNIVERSAL::VERSION' => 1,
|
||||
);
|
||||
}
|
||||
|
||||
my $callpkg = caller();
|
||||
|
||||
if (exists($args{declare})) {
|
||||
*{$callpkg."::declare"} =
|
||||
sub {return $class->declare(shift) }
|
||||
unless defined(&{$callpkg.'::declare'});
|
||||
}
|
||||
|
||||
if (exists($args{qv})) {
|
||||
*{$callpkg."::qv"} =
|
||||
sub {return $class->qv(shift) }
|
||||
unless defined(&{"$callpkg\::qv"});
|
||||
}
|
||||
|
||||
if (exists($args{'UNIVERSAL::VERSION'})) {
|
||||
local $^W;
|
||||
*UNIVERSAL::VERSION = \&version::_VERSION;
|
||||
}
|
||||
|
||||
if (exists($args{'VERSION'})) {
|
||||
*{$callpkg."::VERSION"} = \&version::_VERSION;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
# replace everything from here to the end with the current version/vpp.pm
|
||||
package version::vpp;
|
||||
use strict;
|
||||
|
||||
use POSIX qw/locale_h/;
|
||||
use locale;
|
||||
use vars qw ($VERSION @ISA @REGEXS);
|
||||
$VERSION = '0.77';
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
push @REGEXS, qr/
|
||||
^v? # optional leading 'v'
|
||||
(\d*) # major revision not required
|
||||
\. # requires at least one decimal
|
||||
(?:(\d+)\.?){1,}
|
||||
/x;
|
||||
|
||||
use overload (
|
||||
'""' => \&stringify,
|
||||
'0+' => \&numify,
|
||||
'cmp' => \&vcmp,
|
||||
'<=>' => \&vcmp,
|
||||
'bool' => \&vbool,
|
||||
'nomethod' => \&vnoop,
|
||||
);
|
||||
|
||||
my $VERSION_MAX = 0x7FFFFFFF;
|
||||
|
||||
eval "use warnings";
|
||||
if ($@) {
|
||||
eval '
|
||||
package warnings;
|
||||
sub enabled {return $^W;}
|
||||
1;
|
||||
';
|
||||
}
|
||||
|
||||
sub new
|
||||
{
|
||||
my ($class, $value) = @_;
|
||||
my $self = bless ({}, ref ($class) || $class);
|
||||
|
||||
if ( ref($value) && eval('$value->isa("version")') ) {
|
||||
# Can copy the elements directly
|
||||
$self->{version} = [ @{$value->{version} } ];
|
||||
$self->{qv} = 1 if $value->{qv};
|
||||
$self->{alpha} = 1 if $value->{alpha};
|
||||
$self->{original} = ''.$value->{original};
|
||||
return $self;
|
||||
}
|
||||
|
||||
my $currlocale = setlocale(LC_ALL);
|
||||
|
||||
# if the current locale uses commas for decimal points, we
|
||||
# just replace commas with decimal places, rather than changing
|
||||
# locales
|
||||
if ( localeconv()->{decimal_point} eq ',' ) {
|
||||
$value =~ tr/,/./;
|
||||
}
|
||||
|
||||
if ( not defined $value or $value =~ /^undef$/ ) {
|
||||
# RT #19517 - special case for undef comparison
|
||||
# or someone forgot to pass a value
|
||||
push @{$self->{version}}, 0;
|
||||
$self->{original} = "0";
|
||||
return ($self);
|
||||
}
|
||||
|
||||
if ( $#_ == 2 ) { # must be CVS-style
|
||||
$value = 'v'.$_[2];
|
||||
}
|
||||
|
||||
$value = _un_vstring($value);
|
||||
|
||||
# exponential notation
|
||||
if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
|
||||
$value = sprintf("%.9f",$value);
|
||||
$value =~ s/(0+)$//; # trim trailing zeros
|
||||
}
|
||||
|
||||
# This is not very efficient, but it is morally equivalent
|
||||
# to the XS code (as that is the reference implementation).
|
||||
# See vutil/vutil.c for details
|
||||
my $qv = 0;
|
||||
my $alpha = 0;
|
||||
my $width = 3;
|
||||
my $saw_period = 0;
|
||||
my $vinf = 0;
|
||||
my ($start, $last, $pos, $s);
|
||||
$s = 0;
|
||||
|
||||
while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK
|
||||
$s++;
|
||||
}
|
||||
|
||||
if (substr($value,$s,1) eq 'v') {
|
||||
$s++; # get past 'v'
|
||||
$qv = 1; # force quoted version processing
|
||||
}
|
||||
|
||||
$start = $last = $pos = $s;
|
||||
|
||||
# pre-scan the input string to check for decimals/underbars
|
||||
while ( substr($value,$pos,1) =~ /[._\d,]/ ) {
|
||||
if ( substr($value,$pos,1) eq '.' ) {
|
||||
if ($alpha) {
|
||||
Carp::croak("Invalid version format ".
|
||||
"(underscores before decimal)");
|
||||
}
|
||||
$saw_period++;
|
||||
$last = $pos;
|
||||
}
|
||||
elsif ( substr($value,$pos,1) eq '_' ) {
|
||||
if ($alpha) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version format ".
|
||||
"(multiple underscores)");
|
||||
}
|
||||
$alpha = 1;
|
||||
$width = $pos - $last - 1; # natural width of sub-version
|
||||
}
|
||||
elsif ( substr($value,$pos,1) eq ','
|
||||
and substr($value,$pos+1,1) =~ /[0-9]/ ) {
|
||||
# looks like an unhandled locale
|
||||
$saw_period++;
|
||||
$last = $pos;
|
||||
}
|
||||
$pos++;
|
||||
}
|
||||
|
||||
if ( $alpha && !$saw_period ) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version format ".
|
||||
"(alpha without decimal)");
|
||||
}
|
||||
|
||||
if ( $alpha && $saw_period && $width == 0 ) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version format ".
|
||||
"(misplaced _ in number)");
|
||||
}
|
||||
|
||||
if ( $saw_period > 1 ) {
|
||||
$qv = 1; # force quoted version processing
|
||||
}
|
||||
|
||||
$last = $pos;
|
||||
$pos = $s;
|
||||
|
||||
if ( $qv ) {
|
||||
$self->{qv} = 1;
|
||||
}
|
||||
|
||||
if ( $alpha ) {
|
||||
$self->{alpha} = 1;
|
||||
}
|
||||
|
||||
if ( !$qv && $width < 3 ) {
|
||||
$self->{width} = $width;
|
||||
}
|
||||
|
||||
while ( substr($value,$pos,1) =~ /\d/ ) {
|
||||
$pos++;
|
||||
}
|
||||
|
||||
if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ###
|
||||
my $rev;
|
||||
|
||||
while (1) {
|
||||
$rev = 0;
|
||||
{
|
||||
|
||||
# this is atoi() that delimits on underscores
|
||||
my $end = $pos;
|
||||
my $mult = 1;
|
||||
my $orev;
|
||||
|
||||
# the following if() will only be true after the decimal
|
||||
# point of a version originally created with a bare
|
||||
# floating point number, i.e. not quoted in any way
|
||||
if ( !$qv && $s > $start && $saw_period == 1 ) {
|
||||
$mult *= 100;
|
||||
while ( $s < $end ) {
|
||||
$orev = $rev;
|
||||
$rev += substr($value,$s,1) * $mult;
|
||||
$mult /= 10;
|
||||
if ( abs($orev) > abs($rev)
|
||||
|| abs($rev) > abs($VERSION_MAX) ) {
|
||||
if ( warnings::enabled("overflow") ) {
|
||||
require Carp;
|
||||
Carp::carp("Integer overflow in version");
|
||||
}
|
||||
$s = $end - 1;
|
||||
$rev = $VERSION_MAX;
|
||||
}
|
||||
$s++;
|
||||
if ( substr($value,$s,1) eq '_' ) {
|
||||
$s++;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
while (--$end >= $s) {
|
||||
$orev = $rev;
|
||||
$rev += substr($value,$end,1) * $mult;
|
||||
$mult *= 10;
|
||||
if ( abs($orev) > abs($rev)
|
||||
|| abs($rev) > abs($VERSION_MAX) ) {
|
||||
if ( warnings::enabled("overflow") ) {
|
||||
require Carp;
|
||||
Carp::carp("Integer overflow in version");
|
||||
}
|
||||
$end = $s - 1;
|
||||
$rev = $VERSION_MAX;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Append revision
|
||||
push @{$self->{version}}, $rev;
|
||||
if ( substr($value,$pos,1) eq '.'
|
||||
&& substr($value,$pos+1,1) =~ /\d/ ) {
|
||||
$s = ++$pos;
|
||||
}
|
||||
elsif ( substr($value,$pos,1) eq '_'
|
||||
&& substr($value,$pos+1,1) =~ /\d/ ) {
|
||||
$s = ++$pos;
|
||||
}
|
||||
elsif ( substr($value,$pos,1) eq ','
|
||||
&& substr($value,$pos+1,1) =~ /\d/ ) {
|
||||
$s = ++$pos;
|
||||
}
|
||||
elsif ( substr($value,$pos,1) =~ /\d/ ) {
|
||||
$s = $pos;
|
||||
}
|
||||
else {
|
||||
$s = $pos;
|
||||
last;
|
||||
}
|
||||
if ( $qv ) {
|
||||
while ( substr($value,$pos,1) =~ /\d/ ) {
|
||||
$pos++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $digits = 0;
|
||||
while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) {
|
||||
if ( substr($value,$pos,1) ne '_' ) {
|
||||
$digits++;
|
||||
}
|
||||
$pos++;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if ( $qv ) { # quoted versions always get at least three terms
|
||||
my $len = scalar @{$self->{version}};
|
||||
$len = 3 - $len;
|
||||
while ($len-- > 0) {
|
||||
push @{$self->{version}}, 0;
|
||||
}
|
||||
}
|
||||
|
||||
if ( substr($value,$pos) ) { # any remaining text
|
||||
if ( warnings::enabled("misc") ) {
|
||||
require Carp;
|
||||
Carp::carp("Version string '$value' contains invalid data; ".
|
||||
"ignoring: '".substr($value,$pos)."'");
|
||||
}
|
||||
}
|
||||
|
||||
# cache the original value for use when stringification
|
||||
if ( $vinf ) {
|
||||
$self->{vinf} = 1;
|
||||
$self->{original} = 'v.Inf';
|
||||
}
|
||||
else {
|
||||
$self->{original} = substr($value,0,$pos);
|
||||
}
|
||||
|
||||
return ($self);
|
||||
}
|
||||
|
||||
*parse = \&new;
|
||||
|
||||
sub numify
|
||||
{
|
||||
my ($self) = @_;
|
||||
unless (_verify($self)) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version object");
|
||||
}
|
||||
my $width = $self->{width} || 3;
|
||||
my $alpha = $self->{alpha} || "";
|
||||
my $len = $#{$self->{version}};
|
||||
my $digit = $self->{version}[0];
|
||||
my $string = sprintf("%d.", $digit );
|
||||
|
||||
for ( my $i = 1 ; $i < $len ; $i++ ) {
|
||||
$digit = $self->{version}[$i];
|
||||
if ( $width < 3 ) {
|
||||
my $denom = 10**(3-$width);
|
||||
my $quot = int($digit/$denom);
|
||||
my $rem = $digit - ($quot * $denom);
|
||||
$string .= sprintf("%0".$width."d_%d", $quot, $rem);
|
||||
}
|
||||
else {
|
||||
$string .= sprintf("%03d", $digit);
|
||||
}
|
||||
}
|
||||
|
||||
if ( $len > 0 ) {
|
||||
$digit = $self->{version}[$len];
|
||||
if ( $alpha && $width == 3 ) {
|
||||
$string .= "_";
|
||||
}
|
||||
$string .= sprintf("%0".$width."d", $digit);
|
||||
}
|
||||
else # $len = 0
|
||||
{
|
||||
$string .= sprintf("000");
|
||||
}
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub normal
|
||||
{
|
||||
my ($self) = @_;
|
||||
unless (_verify($self)) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version object");
|
||||
}
|
||||
my $alpha = $self->{alpha} || "";
|
||||
my $len = $#{$self->{version}};
|
||||
my $digit = $self->{version}[0];
|
||||
my $string = sprintf("v%d", $digit );
|
||||
|
||||
for ( my $i = 1 ; $i < $len ; $i++ ) {
|
||||
$digit = $self->{version}[$i];
|
||||
$string .= sprintf(".%d", $digit);
|
||||
}
|
||||
|
||||
if ( $len > 0 ) {
|
||||
$digit = $self->{version}[$len];
|
||||
if ( $alpha ) {
|
||||
$string .= sprintf("_%0d", $digit);
|
||||
}
|
||||
else {
|
||||
$string .= sprintf(".%0d", $digit);
|
||||
}
|
||||
}
|
||||
|
||||
if ( $len <= 2 ) {
|
||||
for ( $len = 2 - $len; $len != 0; $len-- ) {
|
||||
$string .= sprintf(".%0d", 0);
|
||||
}
|
||||
}
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub stringify
|
||||
{
|
||||
my ($self) = @_;
|
||||
unless (_verify($self)) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version object");
|
||||
}
|
||||
return exists $self->{original}
|
||||
? $self->{original}
|
||||
: exists $self->{qv}
|
||||
? $self->normal
|
||||
: $self->numify;
|
||||
}
|
||||
|
||||
sub vcmp
|
||||
{
|
||||
require UNIVERSAL;
|
||||
my ($left,$right,$swap) = @_;
|
||||
my $class = ref($left);
|
||||
unless ( UNIVERSAL::isa($right, $class) ) {
|
||||
$right = $class->new($right);
|
||||
}
|
||||
|
||||
if ( $swap ) {
|
||||
($left, $right) = ($right, $left);
|
||||
}
|
||||
unless (_verify($left)) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version object");
|
||||
}
|
||||
unless (_verify($right)) {
|
||||
require Carp;
|
||||
Carp::croak("Invalid version object");
|
||||
}
|
||||
my $l = $#{$left->{version}};
|
||||
my $r = $#{$right->{version}};
|
||||
my $m = $l < $r ? $l : $r;
|
||||
my $lalpha = $left->is_alpha;
|
||||
my $ralpha = $right->is_alpha;
|
||||
my $retval = 0;
|
||||
my $i = 0;
|
||||
while ( $i <= $m && $retval == 0 ) {
|
||||
$retval = $left->{version}[$i] <=> $right->{version}[$i];
|
||||
$i++;
|
||||
}
|
||||
|
||||
# tiebreaker for alpha with identical terms
|
||||
if ( $retval == 0
|
||||
&& $l == $r
|
||||
&& $left->{version}[$m] == $right->{version}[$m]
|
||||
&& ( $lalpha || $ralpha ) ) {
|
||||
|
||||
if ( $lalpha && !$ralpha ) {
|
||||
$retval = -1;
|
||||
}
|
||||
elsif ( $ralpha && !$lalpha) {
|
||||
$retval = +1;
|
||||
}
|
||||
}
|
||||
|
||||
# possible match except for trailing 0's
|
||||
if ( $retval == 0 && $l != $r ) {
|
||||
if ( $l < $r ) {
|
||||
while ( $i <= $r && $retval == 0 ) {
|
||||
if ( $right->{version}[$i] != 0 ) {
|
||||
$retval = -1; # not a match after all
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
else {
|
||||
while ( $i <= $l && $retval == 0 ) {
|
||||
if ( $left->{version}[$i] != 0 ) {
|
||||
$retval = +1; # not a match after all
|
||||
}
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $retval;
|
||||
}
|
||||
|
||||
sub vbool {
|
||||
my ($self) = @_;
|
||||
return vcmp($self,$self->new("0"),1);
|
||||
}
|
||||
|
||||
sub vnoop {
|
||||
require Carp;
|
||||
Carp::croak("operation not supported with version object");
|
||||
}
|
||||
|
||||
sub is_alpha {
|
||||
my ($self) = @_;
|
||||
return (exists $self->{alpha});
|
||||
}
|
||||
|
||||
sub qv {
|
||||
my $value = shift;
|
||||
my $class = 'version';
|
||||
if (@_) {
|
||||
$class = ref($value) || $value;
|
||||
$value = shift;
|
||||
}
|
||||
|
||||
$value = _un_vstring($value);
|
||||
$value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
|
||||
my $version = $class->new($value);
|
||||
return $version;
|
||||
}
|
||||
|
||||
*declare = \&qv;
|
||||
|
||||
sub is_qv {
|
||||
my ($self) = @_;
|
||||
return (exists $self->{qv});
|
||||
}
|
||||
|
||||
|
||||
sub _verify {
|
||||
my ($self) = @_;
|
||||
if ( ref($self)
|
||||
&& eval { exists $self->{version} }
|
||||
&& ref($self->{version}) eq 'ARRAY'
|
||||
) {
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub _un_vstring {
|
||||
my $value = shift;
|
||||
# may be a v-string
|
||||
if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) {
|
||||
my $tvalue = sprintf("v%vd",$value);
|
||||
if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) {
|
||||
# must be a v-string
|
||||
$value = $tvalue;
|
||||
}
|
||||
}
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub _VERSION {
|
||||
my ($obj, $req) = @_;
|
||||
my $class = ref($obj) || $obj;
|
||||
|
||||
no strict 'refs';
|
||||
eval "require $class" unless %{"$class\::"}; # already existing
|
||||
return undef if $@ =~ /Can't locate/ and not defined $req;
|
||||
|
||||
if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
|
||||
require Carp;
|
||||
Carp::croak( "$class defines neither package nor VERSION"
|
||||
."--version check failed");
|
||||
}
|
||||
|
||||
my $version = eval "\$$class\::VERSION";
|
||||
if ( defined $version ) {
|
||||
local $^W if $] <= 5.008;
|
||||
$version = version::vpp->new($version);
|
||||
}
|
||||
|
||||
if ( defined $req ) {
|
||||
unless ( defined $version ) {
|
||||
require Carp;
|
||||
my $msg = $] < 5.006
|
||||
? "$class version $req required--this is only version "
|
||||
: "$class does not define \$$class\::VERSION"
|
||||
."--version check failed";
|
||||
|
||||
if ( $ENV{VERSION_DEBUG} ) {
|
||||
Carp::confess($msg);
|
||||
}
|
||||
else {
|
||||
Carp::croak($msg);
|
||||
}
|
||||
}
|
||||
|
||||
$req = version::vpp->new($req);
|
||||
|
||||
if ( $req > $version ) {
|
||||
require Carp;
|
||||
if ( $req->is_qv ) {
|
||||
Carp::croak(
|
||||
sprintf ("%s version %s required--".
|
||||
"this is only version %s", $class,
|
||||
$req->normal, $version->normal)
|
||||
);
|
||||
}
|
||||
else {
|
||||
Carp::croak(
|
||||
sprintf ("%s version %s required--".
|
||||
"this is only version %s", $class,
|
||||
$req->stringify, $version->stringify)
|
||||
);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return defined $version ? $version->stringify : undef;
|
||||
}
|
||||
|
||||
1; #this line is important and will help the module return a true value
|
||||
161
inc/Module-Build/Module/Build/YAML.pm
Normal file
161
inc/Module-Build/Module/Build/YAML.pm
Normal file
@@ -0,0 +1,161 @@
|
||||
package Module::Build::YAML;
|
||||
|
||||
use strict;
|
||||
use vars qw($VERSION @EXPORT @EXPORT_OK);
|
||||
$VERSION = "0.50";
|
||||
@EXPORT = ();
|
||||
@EXPORT_OK = qw(Dump Load DumpFile LoadFile);
|
||||
|
||||
sub new {
|
||||
my $this = shift;
|
||||
my $class = ref($this) || $this;
|
||||
my $self = {};
|
||||
bless $self, $class;
|
||||
return($self);
|
||||
}
|
||||
|
||||
sub Dump {
|
||||
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
|
||||
my $yaml = "";
|
||||
foreach my $item (@_) {
|
||||
$yaml .= "---\n";
|
||||
$yaml .= &_yaml_chunk("", $item);
|
||||
}
|
||||
return $yaml;
|
||||
}
|
||||
|
||||
sub Load {
|
||||
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
|
||||
die "not yet implemented";
|
||||
}
|
||||
|
||||
# This is basically copied out of YAML.pm and simplified a little.
|
||||
sub DumpFile {
|
||||
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
|
||||
my $filename = shift;
|
||||
local $/ = "\n"; # reset special to "sane"
|
||||
my $mode = '>';
|
||||
if ($filename =~ /^\s*(>{1,2})\s*(.*)$/) {
|
||||
($mode, $filename) = ($1, $2);
|
||||
}
|
||||
open my $OUT, "$mode $filename"
|
||||
or die "Can't open $filename for writing: $!";
|
||||
binmode($OUT, ':utf8') if $] >= 5.008;
|
||||
print $OUT Dump(@_);
|
||||
close $OUT;
|
||||
}
|
||||
|
||||
# This is basically copied out of YAML.pm and simplified a little.
|
||||
sub LoadFile {
|
||||
shift if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__);
|
||||
my $filename = shift;
|
||||
open my $IN, $filename
|
||||
or die "Can't open $filename for reading: $!";
|
||||
binmode($IN, ':utf8') if $] >= 5.008;
|
||||
return Load(do { local $/; <$IN> });
|
||||
close $IN;
|
||||
}
|
||||
|
||||
sub _yaml_chunk {
|
||||
my ($indent, $values) = @_;
|
||||
my $yaml_chunk = "";
|
||||
my $ref = ref($values);
|
||||
my ($value, @allkeys, %keyseen);
|
||||
if (!$ref) { # a scalar
|
||||
$yaml_chunk .= &_yaml_value($values) . "\n";
|
||||
}
|
||||
elsif ($ref eq "ARRAY") {
|
||||
foreach $value (@$values) {
|
||||
$yaml_chunk .= "$indent-";
|
||||
$ref = ref($value);
|
||||
if (!$ref) {
|
||||
$yaml_chunk .= " " . &_yaml_value($value) . "\n";
|
||||
}
|
||||
else {
|
||||
$yaml_chunk .= "\n";
|
||||
$yaml_chunk .= &_yaml_chunk("$indent ", $value);
|
||||
}
|
||||
}
|
||||
}
|
||||
else { # assume "HASH"
|
||||
if ($values->{_order} && ref($values->{_order}) eq "ARRAY") {
|
||||
@allkeys = @{$values->{_order}};
|
||||
$values = { %$values };
|
||||
delete $values->{_order};
|
||||
}
|
||||
push(@allkeys, sort keys %$values);
|
||||
foreach my $key (@allkeys) {
|
||||
next if (!defined $key || $key eq "" || $keyseen{$key});
|
||||
$keyseen{$key} = 1;
|
||||
$yaml_chunk .= "$indent$key:";
|
||||
$value = $values->{$key};
|
||||
$ref = ref($value);
|
||||
if (!$ref) {
|
||||
$yaml_chunk .= " " . &_yaml_value($value) . "\n";
|
||||
}
|
||||
else {
|
||||
$yaml_chunk .= "\n";
|
||||
$yaml_chunk .= &_yaml_chunk("$indent ", $value);
|
||||
}
|
||||
}
|
||||
}
|
||||
return($yaml_chunk);
|
||||
}
|
||||
|
||||
sub _yaml_value {
|
||||
my ($value) = @_;
|
||||
# undefs become ~
|
||||
return '~' if not defined $value;
|
||||
|
||||
# empty strings will become empty strings
|
||||
return '""' if $value eq '';
|
||||
|
||||
# allow simple scalars (without embedded quote chars) to be unquoted
|
||||
# (includes $%_+=-\;:,./)
|
||||
return $value if $value !~ /["'`~\n!\@\#^\&\*\(\)\{\}\[\]\|<>\?]/;
|
||||
|
||||
# quote and escape strings with special values
|
||||
return "'$value'"
|
||||
if $value !~ /['`~\n!\#^\&\*\(\)\{\}\[\]\|\?]/; # nothing but " or @ or < or > (email addresses)
|
||||
|
||||
$value =~ s/\n/\\n/g; # handle embedded newlines
|
||||
$value =~ s/"/\\"/g; # handle embedded quotes
|
||||
return qq{"$value"};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::YAML - Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Module::Build::YAML;
|
||||
|
||||
...
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Provides just enough YAML support so that Module::Build works even if YAML.pm is not installed.
|
||||
|
||||
Currently, this amounts to the ability to write META.yml files when C<perl Build distmeta>
|
||||
is executed via the Dump() and DumpFile() functions/methods.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Stephen Adkins <spadkins@gmail.com>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2006. Stephen Adkins. All rights reserved.
|
||||
|
||||
This program is free software; you can redistribute it and/or modify it
|
||||
under the same terms as Perl itself.
|
||||
|
||||
See L<http://www.perl.com/perl/misc/Artistic.html>
|
||||
|
||||
=cut
|
||||
|
||||
Reference in New Issue
Block a user