package Module::Build::Base;
use strict;
+use vars qw($VERSION);
+$VERSION = '0.2808_01';
+$VERSION = eval $VERSION;
BEGIN { require 5.00503 }
use Carp;
-use Config;
use File::Copy ();
use File::Find ();
use File::Path ();
use File::Basename ();
use File::Spec 0.82 ();
use File::Compare ();
-use Data::Dumper ();
+use Module::Build::Dumper ();
use IO::File ();
use Text::ParseWords ();
die "Too early to specify a build action '$self->{action}'. Do 'Build $self->{action}' instead.\n"
if $self->{action} && $self->{action} ne 'Build_PL';
- $self->dist_name;
- $self->dist_version;
-
$self->check_manifest;
$self->check_prereq;
$self->check_autofeatures;
+ $self->dist_name;
+ $self->dist_version;
+
$self->_set_install_paths;
$self->_find_nested_builds;
return $self->_backticks(@cmd) eq Config->myconfig;
}
+# cache _discover_perl_interpreter() results
+{
+ my $known_perl;
+ sub find_perl_interpreter {
+ my $self = shift;
+
+ return $known_perl if defined($known_perl);
+ return $known_perl = $self->_discover_perl_interpreter;
+ }
+}
+
# Returns the absolute path of the perl interperter used to invoke
# this process. The path is derived from $^X or $Config{perlpath}. On
# some platforms $^X contains the complete absolute path of the
# executable extension on platforms that use one. It's a fatal error
# if the interpreter can't be found because it can result in undefined
# behavior by routines that depend on it (generating errors or
-# invoking the wrong perl.
-sub find_perl_interpreter {
+# invoking the wrong perl.)
+sub _discover_perl_interpreter {
my $proto = shift;
my $c = ref($proto) ? $proto->{config} : 'Module::Build::Config';
} else {
- # Try 3.B, First look in $Config{perlpath}, then search the users
+ # Try 3.B, First look in $Config{perlpath}, then search the user's
# PATH. We do not want to do either if we are running from an
# uninstalled perl in a perl source tree.
my $exe = $c->get('exe_ext');
foreach my $thisperl ( @potential_perls ) {
- if (defined $exe and $proto->os_type ne 'VMS') {
+ if (defined $exe) {
$thisperl .= $exe unless $thisperl =~ m/$exe$/i;
}
return wantarray ? %features : \%features;
}
-BEGIN { *feature = \&features }
+BEGIN { *feature = \&features } # Alias
sub _mb_feature {
my $self = shift;
meta_merge
original_prefix
prefix_relpaths
+ configure_requires
);
__PACKAGE__->add_property($_) for qw(
die ("Can't determine distribution version, must supply either 'dist_version',\n".
"'dist_version_from', or 'module_name' parameter")
- unless $p->{dist_version};
+ unless defined $p->{dist_version};
return $p->{dist_version};
}
my $file = $self->config_file($filename);
my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
- local $Data::Dumper::Terse = 1;
- print $fh ref($data) ? Data::Dumper::Dumper($data) : $data;
+ unless (ref($data)) { # e.g. magicnum
+ print $fh $data;
+ return;
+ }
+
+ print {$fh} Module::Build::Dumper->_data_dump($data);
}
sub write_config {
sub perl_version_to_float {
my ($self, $version) = @_;
+ return $version if grep( /\./, $version ) < 2;
$version =~ s/\./../;
$version =~ s/\.(\d+)/sprintf '%03d', $1/eg;
return $version;
}
$status{have} = $pm_info->version();
- if ($spec and !$status{have}) {
+ if ($spec and !defined($status{have})) {
@status{ qw(have message) } = (undef, "Couldn't find a \$VERSION in prerequisite $modname");
return \%status;
}
my $case_tolerant = 0+(File::Spec->can('case_tolerant')
&& File::Spec->case_tolerant);
$q{base_dir} = uc $q{base_dir} if $case_tolerant;
- $q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $^O eq 'MSWin32';
+ $q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $self->is_windowsish;
$q{magic_numfile} = $self->config_file('magicnum');
}
$args{ARGV} = \@argv;
+ for ('extra_compiler_flags', 'extra_linker_flags') {
+ $args{$_} = [ $self->split_like_shell($args{$_}) ] if exists $args{$_};
+ }
+
# Hashify these parameters
for ($self->hash_properties, 'config') {
next unless exists $args{$_};
# De-tilde-ify any path parameters
for my $key (qw(prefix install_base destdir)) {
next if !defined $args{$key};
- $args{$key} = _detildefy($args{$key});
+ $args{$key} = $self->_detildefy($args{$key});
}
for my $key (qw(install_path)) {
for my $subkey (keys %{$args{$key}}) {
next if !defined $args{$key}{$subkey};
- my $subkey_ext = _detildefy($args{$key}{$subkey});
+ my $subkey_ext = $self->_detildefy($args{$key}{$subkey});
if ( $subkey eq 'html' ) { # translate for compatability
$args{$key}{binhtml} = $subkey_ext;
$args{$key}{libhtml} = $subkey_ext;
return \%args, $action;
}
-
-sub _detildefy {
- my $arg = shift;
-
- return $arg =~ /^~/ ? (glob $arg)[0] : $arg;
-}
+# Default: do nothing. Overridden for Unix & Windows.
+sub _detildefy {}
# merge Module::Build argument lists that have already been parsed
my ($files_found, @docs) = (0);
foreach my $class ($self->super_classes) {
(my $file = $class) =~ s{::}{/}g;
+ # NOTE: silently skipping relative paths if any chdir() happened
$file = $INC{$file . '.pm'} or next;
my $fh = IO::File->new("< $file") or next;
$files_found++;
last if /^=head1 ACTIONS\s/;
}
- # Look for our action
- my ($found, $inlist) = (0, 0);
+ # Look for our action and determine the style
+ my $style;
while (<$fh>) {
- if (/^=item\s+\Q$action\E\b/) {
- $found = 1;
- } elsif (/^=(item|back)/) {
- last if $found > 1 and not $inlist;
+ last if /^=head1 /;
+
+ # only item and head2 are allowed (3&4 are not in 5.005)
+ if(/^=(item|head2)\s+\Q$action\E\b/) {
+ $style = $1;
+ push @docs, $_;
+ last;
+ }
+ }
+ $style or next; # not here
+
+ # and the content
+ if($style eq 'item') {
+ my ($found, $inlist) = (0, 0);
+ while (<$fh>) {
+ if (/^=(item|back)/) {
+ last unless $inlist;
+ }
+ push @docs, $_;
+ ++$inlist if /^=over/;
+ --$inlist if /^=back/;
}
- next unless $found;
- push @docs, $_;
- ++$inlist if /^=over/;
- --$inlist if /^=back/;
- ++$found if /^\w/; # Found descriptive text
}
+ else { # head2 style
+ # stop at anything equal or greater than the found level
+ while (<$fh>) {
+ last if(/^=(?:head[12]|cut)/);
+ push @docs, $_;
+ }
+ }
+ # TODO maybe disallow overriding just pod for an action
+ # TODO and possibly: @docs and last;
}
unless ($files_found) {
my $vspace = q{ } x ($ver_len - length $mod->{need});
my $f = $mod->{ok} ? ' ' : '!';
$output .=
- " $f $mod->{name} $space $mod->{need} $vspace $mod->{have}\n";
+ " $f $mod->{name} $space $mod->{need} $vspace ".
+ (defined($mod->{have}) ? $mod->{have} : "")."\n";
}
}
return $output;
# See whether any of the *.pm files have changed since last time
# testcover was run. If so, start over.
if (-e 'cover_db') {
- my $pm_files = $self->rscan_dir(File::Spec->catdir($self->blib, 'lib'), qr{\.pm$} );
+ my $pm_files = $self->rscan_dir
+ (File::Spec->catdir($self->blib, 'lib'), file_qr('\.pm$') );
my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/});
$self->do_system(qw(cover -delete))
push @{$p->{include_dirs}}, $p->{c_source};
- my $files = $self->rscan_dir($p->{c_source}, qr{\.c(pp)?$});
+ my $files = $self->rscan_dir($p->{c_source}, file_qr('\.c(pp)?$'));
foreach my $file (@$files) {
push @{$p->{objects}}, $self->compile_c($file);
}
while (my ($file, $to) = each %$files) {
unless ($self->up_to_date( $file, $to )) {
- $self->run_perl_script($file, [], [@$to]);
+ $self->run_perl_script($file, [], [@$to]) or die "$file failed";
$self->add_to_cleanup(@$to);
}
}
foreach my $file (keys %$files) {
my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
- $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
+ $self->fix_shebang_line($result) unless $self->is_vmsish;
$self->make_executable($result);
}
}
}
return unless -d 'lib';
- return { map {$_, [/^(.*)\.PL$/]} @{ $self->rscan_dir('lib', qr{\.PL$}) } };
+ return { map {$_, [/^(.*)\.PL$/i ]} @{ $self->rscan_dir('lib',
+ file_qr('\.PL$')) } };
}
sub find_pm_files { shift->_find_file_by_type('pm', 'lib') }
return { map {$_, $_}
map $self->localize_file_path($_),
grep !/\.\#/,
- @{ $self->rscan_dir($dir, qr{\.$type$}) } };
+ @{ $self->rscan_dir($dir, file_qr("\\.$type\$")) } };
}
sub localize_file_path {
my ($self, $path) = @_;
- $path =~ s/\.\z// if $self->os_type eq 'VMS';
+ $path =~ s/\.\z// if $self->is_vmsish;
return File::Spec->catfile( split m{/}, $path );
}
$shb .= qq{
eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
if 0; # not running under some shell
-} unless $self->os_type eq 'Windows'; # this won't work on win32, so don't
+} unless $self->is_windowsish; # this won't work on win32, so don't
my $FIXOUT = IO::File->new(">$file.new")
or die "Can't create new $file: $!\n";
or die "The 'testpod' action requires Test::Pod version 0.95";
my @files = sort keys %{$self->_find_pods($self->libdoc_dirs)},
- keys %{$self->_find_pods($self->bindoc_dirs, exclude => [ qr/\.bat$/ ])}
+ keys %{$self->_find_pods
+ ($self->bindoc_dirs,
+ exclude => [ file_qr('\.bat$') ])}
or die "Couldn't find any POD files to test\n";
{ package Module::Build::PodTester; # Don't want to pollute the main namespace
or die "The 'testpodcoverage' action requires ",
"Test::Pod::Coverage version 1.00";
+ # TODO this needs test coverage!
+
+ # XXX work-around a bug in Test::Pod::Coverage previous to v1.09
+ # Make sure we test the module in blib/
+ local @INC = @INC;
+ my $p = $self->{properties};
+ unshift(@INC,
+ # XXX any reason to include arch?
+ File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
+ #File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')
+ );
+
all_pod_coverage_ok();
}
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.bat$/ ] );
+ exclude => [ file_qr('\.bat$') ] );
next unless %$files;
my $sub = $self->can("manify_${type}_pods");
my $self = shift;
my $files = $self->_find_pods( $self->{properties}{bindoc_dirs},
- exclude => [ qr/\.bat$/ ] );
+ exclude => [ file_qr('\.bat$') ] );
return unless keys %$files;
my $mandir = File::Spec->catdir( $self->blib, 'bindoc' );
foreach my $type ( qw(bin lib) ) {
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.(?:bat|com|html)$/ ] );
+ exclude =>
+ [ file_qr('\.(?:bat|com|html)$') ] );
next unless %$files;
if ( $self->invoked_action eq 'html' ) {
$self->add_to_cleanup('pod2htm*');
my $pods = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
- exclude => [ qr/\.(?:bat|com|html)$/ ] );
+ exclude => [ file_qr('\.(?:bat|com|html)$') ] );
return unless %$pods; # nothing to do
unless ( -d $htmldir ) {
foreach my $pod ( keys %$pods ) {
my ($name, $path) = File::Basename::fileparse($pods->{$pod},
- qr{\.(?:pm|plx?|pod)$});
+ file_qr('\.(?:pm|plx?|pod)$'));
my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
pop( @dirs ) if $dirs[-1] eq File::Spec->curdir;
delete $installmap->{read};
delete $installmap->{write};
- my $text_suffix = qr{\.(pm|pod)$};
+ my $text_suffix = file_qr('\.(pm|pod)$');
while (my $localdir = each %$installmap) {
my @localparts = File::Spec->splitdir($localdir);
# create a tarball;
# the directory tar'ed must be blib so we need to do a chdir first
- my $start_wd = $self->cwd;
- chdir( $ppm ) or die "Can't chdir to $ppm";
- $self->make_tarball( 'blib', File::Spec->catfile( $start_wd, $ppm ) );
- chdir( $start_wd ) or die "Can't chdir to $start_wd";
+ my $target = File::Spec->catfile( File::Spec->updir, $ppm );
+ $self->_do_in_dir( $ppm, sub { $self->make_tarball( 'blib', $target ) } );
$self->depends_on( 'ppd' );
$self->_add_to_manifest($manifest, "SIGNATURE Added here by Module::Build");
}
- # We protect the signing with an eval{} to make sure we get back to
- # the right directory after a signature failure. Would be nice if
- # Module::Signature took a directory argument.
+ # Would be nice if Module::Signature took a directory argument.
+ $self->_do_in_dir($dir, sub {local $Module::Signature::Quiet = 1; Module::Signature::sign()});
+}
+
+sub _do_in_dir {
+ my ($self, $dir, $do) = @_;
+
my $start_dir = $self->cwd;
chdir $dir or die "Can't chdir() to $dir: $!";
- eval {local $Module::Signature::Quiet = 1; Module::Signature::sign()};
+ eval {$do->()};
my @err = $@ ? ($@) : ();
chdir $start_dir or push @err, "Can't chdir() back to $start_dir: $!";
die join "\n", @err if @err;
$self->depends_on('distdir');
- my $start_dir = $self->cwd;
- my $dist_dir = $self->dist_dir;
- chdir $dist_dir or die "Cannot chdir to $dist_dir: $!";
- # XXX could be different names for scripts
+ $self->_do_in_dir
+ ( $self->dist_dir,
+ sub {
+ # XXX could be different names for scripts
- $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
- or die "Error executing 'Build.PL' in dist directory: $!";
- $self->run_perl_script('Build')
- or die "Error executing 'Build' in dist directory: $!";
- $self->run_perl_script('Build', [], ['test'])
- or die "Error executing 'Build test' in dist directory";
- chdir $start_dir;
+ $self->run_perl_script('Build.PL') # XXX Should this be run w/ --nouse-rcfile
+ or die "Error executing 'Build.PL' in dist directory: $!";
+ $self->run_perl_script('Build')
+ or die "Error executing 'Build' in dist directory: $!";
+ $self->run_perl_script('Build', [], ['test'])
+ or die "Error executing 'Build test' in dist directory";
+ });
}
sub _write_default_maniskip {
ExtUtils::Manifest::mkmanifest();
}
+# Case insenstive regex for files
+sub file_qr {
+ return File::Spec->case_tolerant ? qr($_[0])i : qr($_[0]);
+}
+
sub dist_dir {
my ($self) = @_;
return "$self->{properties}{dist_name}-$self->{properties}{dist_version}";
return $_ = {$_ => 1};
}
- return $_ = { map {$_,1} $self->_files_in( File::Spec->catdir( $self->base_dir, 'bin' ) ) };
+ return $_ = { map {$_,1} $self->_files_in('bin') };
}
BEGIN { *scripts = \&script_files; }
{
- my %licenses =
- (
- perl => 'http://dev.perl.org/licenses/',
- gpl => 'http://www.opensource.org/licenses/gpl-license.php',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- artistic => 'http://opensource.org/licenses/artistic-license.php',
- lgpl => 'http://opensource.org/licenses/artistic-license.php',
- bsd => 'http://www.opensource.org/licenses/bsd-license.php',
- gpl => 'http://www.opensource.org/licenses/gpl-license.php',
- mit => 'http://opensource.org/licenses/mit-license.php',
- mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
- open_source => undef,
- unrestricted => undef,
- restrictive => undef,
- unknown => undef,
- );
+ my %licenses = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+ );
sub valid_licenses {
return \%licenses;
}
$node->{resources}{license} = $url;
}
- foreach ( @{$self->prereq_action_types} ) {
+ if (exists $p->{configure_requires}) {
+ foreach my $spec (keys %{$p->{configure_requires}}) {
+ warn ("Warning: $spec is listed in 'configure_requires', but ".
+ "it is not found in any of the other prereq fields.\n")
+ unless grep exists $p->{$_}{$spec},
+ grep !/conflicts$/, @{$self->prereq_action_types};
+ }
+ }
+
+ foreach ( 'configure_requires', @{$self->prereq_action_types} ) {
if (exists $p->{$_} and keys %{ $p->{$_} }) {
$add_node->($_, $p->{$_});
}
if ($self->create_packlist and my $module_name = $self->module_name) {
my $archdir = $self->install_destination('arch');
my @ext = split /::/, $module_name;
- $map{write} = File::Spec->catdir($archdir, 'auto', @ext, '.packlist');
+ $map{write} = File::Spec->catfile($archdir, 'auto', @ext, '.packlist');
}
# Handle destdir
foreach (keys %map) {
# Need to remove volume from $map{$_} using splitpath, or else
# we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux
- my ($volume, $path) = File::Spec->splitpath( $map{$_}, 1 );
- $map{$_} = File::Spec->catdir($destdir, $path);
+ # VMS will always have the file separate than the path.
+ my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 1 );
+
+ # catdir needs a list of directories, or it will create something
+ # crazy like volume:[Foo.Bar.volume.Baz.Quux]
+ my @dirs = File::Spec->splitdir($path);
+
+ # First merge the directories
+ $path = File::Spec->catdir($destdir, @dirs);
+
+ # Then put the file back on if there is one.
+ if ($file ne '') {
+ $map{$_} = File::Spec->catfile($path, $file)
+ } else {
+ $map{$_} = $path;
+ }
}
}
projects / p5sagit/p5-mst-13.2.git / blobdiff