use strict;
use vars qw($VERSION);
-$VERSION = '0.40';
+use warnings;
+
+$VERSION = '0.4200';
$VERSION = eval $VERSION;
-BEGIN { require 5.00503 }
+BEGIN { require 5.006001 }
use Carp;
use Cwd ();
use File::Spec 0.82 ();
use File::Compare ();
use Module::Build::Dumper ();
-use IO::File ();
use Text::ParseWords ();
use Module::Build::ModuleInfo;
}
sub array_properties {
- for (shift->_mb_classes) {
- return @{$additive_properties{$_}->{ARRAY}}
- if exists $additive_properties{$_}->{ARRAY};
- }
+ map { exists $additive_properties{$_}->{ARRAY} ? @{$additive_properties{$_}->{ARRAY}} : () } shift->_mb_classes;
}
sub hash_properties {
- for (shift->_mb_classes) {
- return @{$additive_properties{$_}->{'HASH'}}
- if exists $additive_properties{$_}->{'HASH'};
- }
+ map { exists $additive_properties{$_}->{HASH} ? @{$additive_properties{$_}->{HASH}} : () } shift->_mb_classes;
}
sub add_property {
return $class;
}
- sub property_error {
- my $self = shift;
- die 'ERROR: ', @_;
- }
+ sub property_error {
+ my $self = shift;
+ die 'ERROR: ', @_;
+ }
sub _set_defaults {
my $self = shift;
}
}
-} # end closure
+} # end enclosure
########################################################################
sub _make_hash_accessor {
my ($property, $p) = @_;
__PACKAGE__->add_property(use_tap_harness => 0);
__PACKAGE__->add_property(cpan_client => 'cpan');
__PACKAGE__->add_property(tap_harness_args => {});
+__PACKAGE__->add_property(pureperl_only => 0);
+__PACKAGE__->add_property(allow_pureperl => 0);
__PACKAGE__->add_property(
'installdirs',
default => 'site',
}
{
- my @prereq_action_types = qw(requires build_requires conflicts recommends);
+ my @prereq_action_types = qw(requires build_requires test_requires conflicts recommends);
foreach my $type (@prereq_action_types) {
__PACKAGE__->add_property($type => {});
}
verbose
debug
xs_files
+ extra_manify_args
);
sub config {
File::Path::mkpath($filedir);
die "Can't create directory $filedir: $!" unless -d $filedir;
- my $fh = IO::File->new("> $filename") or die "Can't create $filename: $!";
+ open(my $fh, '>', $filename) or die "Can't create $filename: $!";
print $fh <<EOF;
package $opts{class};
use $pack;
sub dist_name {
my $self = shift;
my $p = $self->{properties};
- return $p->{dist_name} if defined $p->{dist_name};
+ my $me = 'dist_name';
+ return $p->{$me} if defined $p->{$me};
die "Can't determine distribution name, must supply either 'dist_name' or 'module_name' parameter"
unless $self->module_name;
- ($p->{dist_name} = $self->module_name) =~ s/::/-/g;
+ ($p->{$me} = $self->module_name) =~ s/::/-/g;
- return $p->{dist_name};
+ return $p->{$me};
}
sub release_status {
my ($self) = @_;
+ my $me = 'release_status';
my $p = $self->{properties};
- if ( ! defined $p->{release_status} ) {
- $p->{release_status} = $self->_is_dev_version ? 'testing' : 'stable';
+ if ( ! defined $p->{$me} ) {
+ $p->{$me} = $self->_is_dev_version ? 'testing' : 'stable';
}
- unless ( $p->{release_status} =~ qr/\A(?:stable|testing|unstable)\z/ ) {
- die "Illegal value '$p->{release_status}' for release_status\n";
+ unless ( $p->{$me} =~ qr/\A(?:stable|testing|unstable)\z/ ) {
+ die "Illegal value '$p->{$me}' for $me\n";
}
- if ( $p->{release_status} eq 'stable' && $self->_is_dev_version ) {
+ if ( $p->{$me} eq 'stable' && $self->_is_dev_version ) {
my $version = $self->dist_version;
- die "Illegal value '$p->{release_status}' with version '$version'\n";
+ die "Illegal value '$p->{$me}' with version '$version'\n";
}
- return $p->{release_status};
+ return $p->{$me};
}
sub dist_suffix {
my ($self) = @_;
my $p = $self->{properties};
- return $p->{dist_suffix} if defined $p->{dist_suffix};
+ my $me = 'dist_suffix';
+
+ return $p->{$me} if defined $p->{$me};
if ( $self->release_status eq 'stable' ) {
- $p->{dist_suffix} = "";
+ $p->{$me} = "";
}
else {
# non-stable release but non-dev version number needs '-TRIAL' appended
- $p->{dist_suffix} = $self->_is_dev_version ? "" : "TRIAL" ;
+ $p->{$me} = $self->_is_dev_version ? "" : "TRIAL" ;
}
- return $p->{dist_suffix};
+ return $p->{$me};
}
sub dist_version_from {
my ($self) = @_;
my $p = $self->{properties};
+ my $me = 'dist_version_from';
+
if ($self->module_name) {
- $p->{dist_version_from} ||=
+ $p->{$me} ||=
join( '/', 'lib', split(/::/, $self->module_name) ) . '.pm';
}
- return $p->{dist_version_from} || undef;
+ return $p->{$me} || undef;
}
sub dist_version {
my ($self) = @_;
my $p = $self->{properties};
+ my $me = 'dist_version';
- return $p->{dist_version} if defined $p->{dist_version};
+ return $p->{$me} if defined $p->{$me};
if ( my $dist_version_from = $self->dist_version_from ) {
my $version_from = File::Spec->catfile( split( qr{/}, $dist_version_from ) );
my $pm_info = Module::Build::ModuleInfo->new_from_file( $version_from )
or die "Can't find file $version_from to determine version";
- #$p->{dist_version} is undef here
- $p->{dist_version} = $self->normalize_version( $pm_info->version() );
- unless (defined $p->{dist_version}) {
+ #$p->{$me} is undef here
+ $p->{$me} = $self->normalize_version( $pm_info->version() );
+ unless (defined $p->{$me}) {
die "Can't determine distribution version from $version_from";
}
}
die ("Can't determine distribution version, must supply either 'dist_version',\n".
"'dist_version_from', or 'module_name' parameter")
- unless defined $p->{dist_version};
+ unless defined $p->{$me};
- return $p->{dist_version};
+ return $p->{$me};
}
sub _is_dev_version {
my $docfile = $self->_main_docfile
or return;
- my $fh = IO::File->new($docfile)
+ open(my $fh, '<', $docfile)
or return;
require Module::Build::PodParser;
my $file = $self->config_file('build_params')
or die "Can't find 'build_params' in " . $self->config_dir;
- my $fh = IO::File->new($file) or die "Can't read '$file': $!";
+ open(my $fh, '<', $file) or die "Can't read '$file': $!";
my $ref = eval do {local $/; <$fh>};
die if $@;
+ close $fh;
my $c;
($self->{args}, $c, $self->{properties}) = @$ref;
$self->{config} = Module::Build::Config->new(values => $c);
- close $fh;
}
sub has_config_data {
my ($self, $filename, $data) = @_;
my $file = $self->config_file($filename);
- my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
+ open(my $fh, '>', $file) or die "Can't create '$file': $!";
unless (ref($data)) { # e.g. magicnum
print $fh $data;
return;
}
print {$fh} Module::Build::Dumper->_data_dump($data);
+ close $fh;
}
sub write_config {
my ($self) = @_;
my $p = $self->{properties};
- # If needs_compiler is not explictly set, automatically set it
+ # If needs_compiler is not explicitly set, automatically set it
# If set, we need ExtUtils::CBuilder (and a compiler)
my $xs_files = $self->find_xs_files;
if ( ! defined $p->{needs_compiler} ) {
sub _parse_conditions {
my ($self, $spec) = @_;
+ return ">= 0" if not defined $spec;
if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores
return (">= $spec");
} else {
my @myINC = $self->_added_to_INC;
for (@myINC, values %q) {
- $_ = File::Spec->canonpath( $_ );
+ $_ = File::Spec->canonpath( $_ ) unless $self->is_vmsish;
s/([\\\'])/\\$1/g;
}
sub magic_number_matches {
return 0 unless -e '$q{magic_numfile}';
- local *FH;
- open FH, '$q{magic_numfile}' or return 0;
- my \$filenum = <FH>;
- close FH;
+ my \$FH;
+ open \$FH, '<','$q{magic_numfile}' or return 0;
+ my \$filenum = <\$FH>;
+ close \$FH;
return \$filenum == $magic_number;
}
if ( $self->try_require("CPAN::Meta", "2.110420") ) {
for my $file ( @metafiles ) {
next unless -f $file;
- $meta_obj = eval { CPAN::Meta->load_file($file) };
+ $meta_obj = eval { CPAN::Meta->load_file($file, { lazy_validation => 0 }) };
last if $meta_obj;
}
}
# maybe get a copy in spec v2 format (regardless of original source)
- $mymeta = $meta_obj->as_struct
- if $meta_obj;
+ my $mymeta_obj = $self->_get_meta_object(quiet => 0, dynamic => 0, fatal => 1, auto => 0);
# if we have metadata, just update it
- if ( defined $mymeta ) {
- my $prereqs = $self->_normalize_prereqs;
- # XXX refactor this mapping somewhere
- $mymeta->{prereqs}{runtime}{requires} = $prereqs->{requires};
- $mymeta->{prereqs}{build}{requires} = $prereqs->{build_requires};
- $mymeta->{prereqs}{runtime}{recommends} = $prereqs->{recommends};
- $mymeta->{prereqs}{runtime}{conflicts} = $prereqs->{conflicts};
- # delete empty entries
- for my $phase ( keys %{$mymeta->{prereqs}} ) {
- if ( ref $mymeta->{prereqs}{$phase} eq 'HASH' ) {
- for my $type ( keys %{$mymeta->{prereqs}{$phase}} ) {
- if ( ! defined $mymeta->{prereqs}{$phase}{$type}
- || ! keys %{$mymeta->{prereqs}{$phase}{$type}}
- ) {
- delete $mymeta->{prereqs}{$phase}{$type};
- }
- }
- }
- if ( ! defined $mymeta->{prereqs}{$phase}
- || ! keys %{$mymeta->{prereqs}{$phase}}
- ) {
- delete $mymeta->{prereqs}{$phase};
- }
- }
- $mymeta->{dynamic_config} = 0;
- $mymeta->{generated_by} = "Module::Build version $Module::Build::VERSION";
- eval { $meta_obj = CPAN::Meta->new( $mymeta, { lazy_validation => 1 } ) }
- }
- # or generate from scratch, ignoring errors if META doesn't exist
- else {
- $meta_obj = $self->_get_meta_object(
- quiet => 0, dynamic => 0, fatal => 0, auto => 0
+ if ($meta_obj && $mymeta_obj) {
+ my $prereqs = $mymeta_obj->effective_prereqs->with_merged_prereqs($meta_obj->effective_prereqs);
+ my %updated = (
+ %{ $meta_obj->as_struct({ version => 2.0 }) },
+ prereqs => $prereqs->as_string_hash,
+ dynamic_config => 0,
+ generated_by => "Module::Build version $Module::Build::VERSION",
);
+ $mymeta_obj = CPAN::Meta->new( \%updated, { lazy_validation => 0 } );
}
- my @created = $self->_write_meta_files( $meta_obj, 'MYMETA' );
+ my @created = $self->_write_meta_files( $mymeta_obj, 'MYMETA' );
$self->log_warn("Could not create MYMETA files\n")
unless @created;
$self->log_info("Creating new '$build_script' script for ",
"'$dist_name' version '$dist_version'\n");
- my $fh = IO::File->new(">$build_script") or die "Can't create '$build_script': $!";
+ open(my $fh, '>', $build_script) or die "Can't create '$build_script': $!";
$self->print_build_script($fh);
close $fh;
use_tap_harness
tap_harness_args
cpan_client
+ pureperl_only
+ allow_pureperl
); # normalize only selected option names
return $opt;
debug
sign
use_tap_harness
+ pureperl_only
+ allow_pureperl
);
# inverted boolean options; eg --noverbose or --no-verbose
return () unless $modulebuildrc;
}
- my $fh = IO::File->new( $modulebuildrc )
+ open(my $fh, '<', $modulebuildrc )
or die "Can't open $modulebuildrc: $!";
my %options; my $buffer = '';
(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;
+ open(my $fh, '<', $file) or next;
$files_found++;
# Code below modified from /usr/bin/perldoc
sub run_test_harness {
my ($self, $tests) = @_;
require Test::Harness;
- my $p = $self->{properties};
- my @harness_switches = $self->harness_switches;
-
- # Work around a Test::Harness bug that loses the particular perl
- # we're running under. $self->perl is trustworthy, but $^X isn't.
- local $^X = $self->perl;
-
- # Do everything in our power to work with all versions of Test::Harness
- local $Test::Harness::switches = join ' ', grep defined, $Test::Harness::switches, @harness_switches;
- local $Test::Harness::Switches = join ' ', grep defined, $Test::Harness::Switches, @harness_switches;
- local $ENV{HARNESS_PERL_SWITCHES} = join ' ', grep defined, $ENV{HARNESS_PERL_SWITCHES}, @harness_switches;
- $Test::Harness::switches = undef unless length $Test::Harness::switches;
- $Test::Harness::Switches = undef unless length $Test::Harness::Switches;
- delete $ENV{HARNESS_PERL_SWITCHES} unless length $ENV{HARNESS_PERL_SWITCHES};
-
- local ($Test::Harness::verbose,
- $Test::Harness::Verbose,
- $ENV{TEST_VERBOSE},
- $ENV{HARNESS_VERBOSE}) = ($p->{verbose} || 0) x 4;
+ local $Test::Harness::verbose = $self->verbose || 0;
+ local $Test::Harness::switches = join ' ', $self->harness_switches;
Test::Harness::runtests(@$tests);
}
sub process_xs_files {
my $self = shift;
+ return if $self->pureperl_only && $self->allow_pureperl;
my $files = $self->find_xs_files;
+ croak 'Can\'t build xs files under --pureperl-only' if %$files && $self->pureperl_only;
while (my ($from, $to) = each %$files) {
unless ($from eq $to) {
$self->add_to_cleanup($to);
my ($does_shbang) = $c->get('sharpbang') =~ /^\s*\#\!/;
for my $file (@files) {
- my $FIXIN = IO::File->new($file) or die "Can't process '$file': $!";
+ open(my $FIXIN, '<', $file) or die "Can't process '$file': $!";
local $/ = "\n";
chomp(my $line = <$FIXIN>);
- next unless $line =~ s/^\s*\#!\s*//; # Not a shbang file.
+ next unless $line =~ s/^\s*\#!\s*//; # Not a shebang file.
my ($cmd, $arg) = (split(' ', $line, 2), '');
next unless $cmd =~ /perl/i;
if 0; # not running under some shell
} unless $self->is_windowsish; # this won't work on win32, so don't
- my $FIXOUT = IO::File->new(">$file.new")
+ open(my $FIXOUT, '>', "$file.new")
or die "Can't create new $file: $!\n";
# Print out the new #! line (or equivalent).
$self->depends_on('code');
+ my %extra_manify_args = $self->{properties}{'extra_manify_args'} ? %{ $self->{properties}{'extra_manify_args'} } : ();
+
foreach my $type ( qw(bin lib) ) {
next unless ( $self->invoked_action eq 'manpages' || $self->_is_default_installable("${type}doc"));
my $files = $self->_find_pods( $self->{properties}{"${type}doc_dirs"},
next unless %$files;
my $sub = $self->can("manify_${type}_pods");
- $self->$sub() if defined( $sub );
+ $self->$sub( %extra_manify_args ) if defined( $sub );
}
}
sub manify_bin_pods {
my $self = shift;
+ my %podman_args = (section => 1, @_); # binaries go in section 1
my $files = $self->_find_pods( $self->{properties}{bindoc_dirs},
exclude => [ $self->file_qr('\.bat$') ] );
foreach my $file (keys %$files) {
# Pod::Simple based parsers only support one document per instance.
# This is expected to change in a future version (Pod::Simple > 3.03).
- my $parser = Pod::Man->new( section => 1 ); # binaries go in section 1
+ my $parser = Pod::Man->new( %podman_args );
my $manpage = $self->man1page_name( $file ) . '.' .
$self->config( 'man1ext' );
my $outfile = File::Spec->catfile($mandir, $manpage);
sub manify_lib_pods {
my $self = shift;
+ my %podman_args = (section => 3, @_); # libraries go in section 3
my $files = $self->_find_pods($self->{properties}{libdoc_dirs});
return unless keys %$files;
while (my ($file, $relfile) = each %$files) {
# Pod::Simple based parsers only support one document per instance.
# This is expected to change in a future version (Pod::Simple > 3.03).
- my $parser = Pod::Man->new( section => 3 ); # libraries go in section 3
+ my $parser = Pod::Man->new( %podman_args );
my $manpage = $self->man3page_name( $relfile ) . '.' .
$self->config( 'man3ext' );
my $outfile = File::Spec->catfile( $mandir, $manpage);
foreach my $regexp ( @{ $args{exclude} } ) {
next FILE if $file =~ $regexp;
}
+ $file = $self->localize_file_path($file);
$files{$file} = File::Spec->abs2rel($file, $dir) if $self->contains_pod( $file )
}
}
my ($self, $file) = @_;
return '' unless -T $file; # Only look at text files
- my $fh = IO::File->new( $file ) or die "Can't open $file: $!";
+ open(my $fh, '<', $file ) or die "Can't open $file: $!";
while (my $line = <$fh>) {
return 1 if $line =~ /^\=(?:head|pod|item)/;
}
: $self->original_prefix('core');
my $htmlroot = $self->install_sets('core')->{libhtml};
- my @podpath = (map { File::Spec->abs2rel($_ ,$podroot) } grep { -d }
- ( $self->install_sets('core', 'lib'), # lib
- $self->install_sets('core', 'bin'), # bin
- $self->install_sets('site', 'lib'), # site/lib
- ) ), File::Spec->rel2abs($self->blib);
+ my $podpath;
+ unless (defined $self->args('html_links') and !$self->args('html_links')) {
+ my @podpath = ( (map { File::Spec->abs2rel($_ ,$podroot) } grep { -d }
+ ( $self->install_sets('core', 'lib'), # lib
+ $self->install_sets('core', 'bin'), # bin
+ $self->install_sets('site', 'lib'), # site/lib
+ ) ), File::Spec->rel2abs($self->blib) );
- my $podpath = $ENV{PERL_CORE}
- ? File::Spec->catdir($podroot, 'lib')
- : join(":", map { tr,:\\,|/,; $_ } @podpath);
+ $podpath = $ENV{PERL_CORE}
+ ? File::Spec->catdir($podroot, 'lib')
+ : join(":", map { tr,:\\,|/,; $_ } @podpath);
+ }
my $blibdir = join('/', File::Spec->splitdir(
(File::Spec->splitpath(File::Spec->rel2abs($htmldir),1))[1]),''
my $depth = @rootdirs + @dirs;
my %opts = ( infile => $infile,
outfile => $tmpfile,
- podpath => $podpath,
+ ( defined($podpath) ? (podpath => $podpath) : ()),
podroot => $podroot,
index => 1,
depth => $depth,
} or $self->log_warn("[$htmltool] pod2html (" .
join(", ", map { "q{$_} => q{$opts{$_}}" } (keys %opts)) . ") failed: $@");
} else {
- my $path2root = join( '/', ('..') x (@rootdirs+@dirs) );
- my $fh = IO::File->new($infile) or die "Can't read $infile: $!";
+ my $path2root = File::Spec->catdir((File::Spec->updir) x @dirs);
+ open(my $fh, '<', $infile) or die "Can't read $infile: $!";
my $abstract = Module::Build::PodParser->new(fh => $fh)->get_abstract();
my $title = join( '::', (@dirs, $name) );
my @opts = (
"--title=$title",
- "--podpath=$podpath",
+ ( defined($podpath) ? "--podpath=$podpath" : ()),
"--infile=$infile",
"--outfile=$tmpfile",
"--podroot=$podroot",
- "--htmlroot=$path2root",
+ ($path2root ? "--htmlroot=$path2root" : ()),
);
unless ( eval{Pod::Html->VERSION(1.12)} ) {
$errors++;
next POD;
}
- my $fh = IO::File->new($tmpfile) or die "Can't read $tmpfile: $!";
+ open(my $fh, '<', $tmpfile) or die "Can't read $tmpfile: $!";
my $html = join('',<$fh>);
- $fh->close;
+ close $fh;
if (!$self->_is_ActivePerl) {
# These fixups are already done by AP::DT:P:pod2html
# The output from pod2html is NOT XHTML!
# Fixup links that point to our temp blib
$html =~ s/\Q$blibdir\E//g;
- $fh = IO::File->new(">$outfile") or die "Can't write $outfile: $!";
+ open($fh, '>', $outfile) or die "Can't write $outfile: $!";
print $fh $html;
- $fh->close;
+ close $fh;
unlink($tmpfile);
}
my ($self) = @_;
require ExtUtils::Install;
$self->depends_on('build');
- # RT#63003 suggest that odd cirmstances that we might wind up
+ # RT#63003 suggest that odd circumstances that we might wind up
# in a different directory than we started, so wrap with _do_in_dir to
# ensure we get back to where we started; hope this fixes it!
$self->_do_in_dir( ".", sub {
}
}
- if ( ! -x $command ) {
- die "cpan_client '$command' is not executable\n";
- }
-
$self->do_system($command, @opts, @install);
}
my $mode = (stat $manifest)[2];
chmod($mode | oct(222), $manifest) or die "Can't make $manifest writable: $!";
- my $fh = IO::File->new("< $manifest") or die "Can't read $manifest: $!";
+ open(my $fh, '<', $manifest) or die "Can't read $manifest: $!";
my $last_line = (<$fh>)[-1] || "\n";
my $has_newline = $last_line =~ /\n$/;
- $fh->close;
+ close $fh;
- $fh = IO::File->new(">> $manifest") or die "Can't write to $manifest: $!";
+ open($fh, '>>', $manifest) or die "Can't write to $manifest: $!";
print $fh "\n" unless $has_newline;
print $fh map "$_\n", @$lines;
close $fh;
$self->delete_filetree('LICENSE');
- my $fh = IO::File->new('> LICENSE')
+ open(my $fh, '>', 'LICENSE')
or die "Can't write LICENSE file: $!";
print $fh $license->fulltext;
close $fh;
} elsif ( eval {require Pod::Text; 1} ) {
$self->log_info("Creating README using Pod::Text\n");
- my $fh = IO::File->new('> README');
- if ( defined($fh) ) {
+ if ( open(my $fh, '>', 'README') ) {
local $^W = 0;
no strict "refs";
Pod::Text::pod2text( $docfile, $fh );
- $fh->close;
+ close $fh;
} else {
$self->log_warn(
"Cannot create 'README' file: Can't open file for writing\n" );
$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'])
+ $self->run_perl_script($self->build_script)
+ or die "Error executing $self->build_script in dist directory: $!";
+ $self->run_perl_script($self->build_script, [], ['test'])
or die "Error executing 'Build test' in dist directory";
});
}
sub {
$self->run_perl_script('Build.PL')
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', [], ['install'])
+ $self->run_perl_script($self->build_script)
+ or die "Error executing $self->build_script in dist directory: $!";
+ $self->run_perl_script($self->build_script, [], ['install'])
or die "Error executing 'Build install' in dist directory";
}
);
my $skip = shift;
my $file = shift || 'MANIFEST.SKIP';
return unless defined $skip && length $skip;
- my $fh = IO::File->new(">> $file")
+ open(my $fh, '>>', $file)
or die "Can't open $file: $!";
print $fh "$skip\n";
- $fh->close();
+ close $fh;
}
sub _write_default_maniskip {
my $self = shift;
my $file = shift || 'MANIFEST.SKIP';
- my $fh = IO::File->new("> $file")
+ open(my $fh, '>', $file)
or die "Can't open $file: $!";
my $content = $self->_eumanifest_has_include ? "#!include_default\n"
$content .= '\b'.$self->dist_name.'-[\d\.\_]+'."\n";
print $fh $content;
+
+ close $fh;
return;
}
auto => $args{auto},
);
$data->{dynamic_config} = $args{dynamic} if defined $args{dynamic};
- $meta = CPAN::Meta->create( $data );
+ $meta = CPAN::Meta->create($data);
};
if ($@ && ! $args{quiet}) {
$self->log_warn(
return $version;
}
+my %prereq_map = (
+ requires => [ qw/runtime requires/],
+ configure_requires => [qw/configure requires/],
+ build_requires => [ qw/build requires/ ],
+ test_requires => [ qw/test requires/ ],
+ test_recommends => [ qw/test recommends/ ],
+ recommends => [ qw/build recommends/ ],
+ conflicts => [ qw/build conflicts/ ],
+);
+
sub _normalize_prereqs {
my ($self) = @_;
my $p = $self->{properties};
# copy prereq data structures so we can modify them before writing to META
my %prereq_types;
for my $type ( 'configure_requires', @{$self->prereq_action_types} ) {
- if (exists $p->{$type}) {
+ if (exists $p->{$type} and keys %{ $p->{$type} }) {
+ my ($phase, $relation) = @{ $prereq_map{$type} };
for my $mod ( keys %{ $p->{$type} } ) {
- $prereq_types{$type}{$mod} =
- $self->normalize_version($p->{$type}{$mod});
+ $prereq_types{$phase}{$relation}{$mod} = $self->normalize_version($p->{$type}{$mod});
}
}
}
return \%prereq_types;
}
-# wrapper around old prepare_metadata API;
-sub get_metadata {
- my ($self, %args) = @_;
- my $metadata = {};
- $self->prepare_metadata( $metadata, undef, \%args );
- return $metadata;
+sub _get_license {
+ my $self = shift;
+
+ my $license = $self->license;
+ my ($meta_license, $meta_license_url);
+
+ my $valid_licenses = $self->valid_licenses();
+ if ( my $sl = $self->_software_license_object ) {
+ $meta_license = $sl->meta2_name;
+ $meta_license_url = $sl->url;
+ }
+ elsif ( exists $valid_licenses->{$license} ) {
+ $meta_license = $valid_licenses->{$license} ? lc $valid_licenses->{$license} : $license;
+ $meta_license_url = $self->_license_url( $license );
+ }
+ else {
+ $self->log_warn( "Can not determine license type for '" . $self->license
+ . "'\nSetting META license field to 'unknown'.\n");
+ $meta_license = 'unknown';
+ }
+ return ($meta_license, $meta_license_url);
}
-# To preserve compatibility with old API, $node *must* be a hashref
-# passed in to prepare_metadata. $keys is an arrayref holding a
-# list of keys -- it's use is optional and generally no longer needed
-# but kept for back compatibility. $args is an optional parameter to
-# support the new 'fatal' toggle
+my %keep = map { $_ => 1 } qw/keywords dynamic_config provides no_index name version abstract/;
+my %ignore = map { $_ => 1 } qw/distribution_type/;
+my %reject = map { $_ => 1 } qw/private author license requires recommends build_requires configure_requires conflicts/;
-sub prepare_metadata {
- my ($self, $node, $keys, $args) = @_;
- unless ( ref $node eq 'HASH' ) {
- croak "prepare_metadata() requires a hashref argument to hold output\n";
+sub _upconvert_resources {
+ my ($input) = @_;
+ my %output;
+ for my $key (keys %{$input}) {
+ my $out_key = $key =~ /^\p{Lu}/ ? "x_\l$key" : $key;
+ if ($key eq 'repository') {
+ my $name = $input->{$key} =~ m{ \A http s? :// .* (<! \.git ) \z }xms ? 'web' : 'url';
+ $output{$out_key} = { $name => $input->{$key} };
+ }
+ elsif ($key eq 'bugtracker') {
+ $output{$out_key} = { web => $input->{$key} }
+ }
+ else {
+ $output{$out_key} = $input->{$key};
+ }
}
- my $fatal = $args->{fatal} || 0;
- my $p = $self->{properties};
+ return \%output
+}
+my %custom = (
+ resources => \&_upconvert_resources,
+);
- $self->auto_config_requires if $args->{auto};
+sub _upconvert_metapiece {
+ my ($input, $type) = @_;
+ return $input if exists $input->{'meta-spec'} && $input->{'meta-spec'}{version} == 2;
- # A little helper sub
- my $add_node = sub {
- my ($name, $val) = @_;
- $node->{$name} = $val;
- push @$keys, $name if $keys;
- };
+ my %ret;
+ for my $key (keys %{$input}) {
+ if ($keep{$key}) {
+ $ret{$key} = $input->{$key};
+ }
+ elsif ($ignore{$key}) {
+ next;
+ }
+ elsif ($reject{$key}) {
+ croak "Can't $type $key, please use another mechanism";
+ }
+ elsif (my $converter = $custom{$key}) {
+ $ret{$key} = $converter->($input->{$key});
+ }
+ else {
+ warn "Unknown key $key\n" unless $key =~ / \A x_ /xi;
+ }
+ }
+ return \%ret;
+}
+
+sub get_metadata {
+ my ($self, %args) = @_;
+
+ my $fatal = $args{fatal} || 0;
+ my $p = $self->{properties};
+
+ $self->auto_config_requires if $args{auto};
# validate required fields
foreach my $f (qw(dist_name dist_version dist_author dist_abstract license)) {
}
}
+ my %metadata = (
+ name => $self->dist_name,
+ version => $self->normalize_version($self->dist_version),
+ author => $self->dist_author,
+ abstract => $self->dist_abstract,
+ generated_by => "Module::Build version $Module::Build::VERSION",
+ 'meta-spec' => {
+ version => '2',
+ url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
+ },
+ dynamic_config => exists $p->{dynamic_config} ? $p->{dynamic_config} : 1,
+ release_status => $self->release_status,
+ );
- # add dist_* fields
- foreach my $f (qw(dist_name dist_version dist_author dist_abstract)) {
- (my $name = $f) =~ s/^dist_//;
- $add_node->($name, $self->$f());
- }
-
- # normalize version
- $node->{version} = $self->normalize_version($node->{version});
-
- # validate license information
- my $license = $self->license;
- my ($meta_license, $meta_license_url);
-
- # XXX this is still meta spec version 1 stuff
-
- # if Software::License::* exists, then we can use it to get normalized name
- # for META files
-
- if ( my $sl = $self->_software_license_object ) {
- $meta_license = $sl->meta_name;
- $meta_license_url = $sl->url;
- }
- elsif ( exists $self->valid_licenses()->{$license} ) {
- $meta_license = $license;
- $meta_license_url = $self->_license_url( $license );
- }
- else {
- # if we didn't find a license from a Software::License class,
- # then treat it as unknown
- $self->log_warn( "Can not determine license type for '" . $self->license
- . "'\nSetting META license field to 'unknown'.\n");
- $meta_license = 'unknown';
- }
-
- $node->{license} = $meta_license;
- $node->{resources}{license} = $meta_license_url if defined $meta_license_url;
+ my ($meta_license, $meta_license_url) = $self->_get_license;
+ $metadata{license} = [ $meta_license ];
+ $metadata{resources}{license} = [ $meta_license_url ] if defined $meta_license_url;
- # add prerequisite data
- my $prereqs = $self->_normalize_prereqs;
- for my $t ( keys %$prereqs ) {
- $add_node->($t, $prereqs->{$t});
- }
+ $metadata{prereqs} = $self->_normalize_prereqs;
- if (exists $p->{dynamic_config}) {
- $add_node->('dynamic_config', $p->{dynamic_config});
- }
- my $pkgs = eval { $self->find_dist_packages };
- if ($@) {
+ if (exists $p->{no_index}) {
+ $metadata{no_index} = $p->{no_index};
+ } elsif (my $pkgs = eval { $self->find_dist_packages }) {
+ $metadata{provides} = $pkgs if %$pkgs;
+ } else {
$self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" .
"Nothing to enter for 'provides' field in metafile.\n");
- } else {
- $node->{provides} = $pkgs if %$pkgs;
}
-;
- if (exists $p->{no_index}) {
- $add_node->('no_index', $p->{no_index});
+
+ my $meta_add = _upconvert_metapiece($self->meta_add, 'add');
+ while (my($k, $v) = each %{$meta_add} ) {
+ $metadata{$k} = $v;
}
- $add_node->('generated_by', "Module::Build version $Module::Build::VERSION");
+ my $meta_merge = _upconvert_metapiece($self->meta_merge, 'merge');
+ while (my($k, $v) = each %{$meta_merge} ) {
+ $self->_hash_merge(\%metadata, $k, $v);
+ }
- $add_node->('meta-spec',
- {version => '1.4',
- url => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
- });
+ return \%metadata;
+}
- while (my($k, $v) = each %{$self->meta_add}) {
- $add_node->($k, $v);
- }
+# To preserve compatibility with old API, $node *must* be a hashref
+# passed in to prepare_metadata. $keys is an arrayref holding a
+# list of keys -- it's use is optional and generally no longer needed
+# but kept for back compatibility. $args is an optional parameter to
+# support the new 'fatal' toggle
- while (my($k, $v) = each %{$self->meta_merge}) {
- $self->_hash_merge($node, $k, $v);
+sub prepare_metadata {
+ my ($self, $node, $keys, $args) = @_;
+ unless ( ref $node eq 'HASH' ) {
+ croak "prepare_metadata() requires a hashref argument to hold output\n";
}
-
+ croak 'Keys argument to prepare_metadata is no longer supported' if $keys;
+ %{$node} = %{ $self->get_meta(%{$args}) };
return $node;
}
@typemaps, $file);
$self->log_info("@command\n");
- my $fh = IO::File->new("> $args{outfile}") or die "Couldn't write $args{outfile}: $!";
+ open(my $fh, '>', $args{outfile}) or die "Couldn't write $args{outfile}: $!";
print {$fh} $self->_backticks(@command);
close $fh;
}
require ExtUtils::Mkbootstrap;
$self->log_info("ExtUtils::Mkbootstrap::Mkbootstrap('$spec->{bs_file}')\n");
ExtUtils::Mkbootstrap::Mkbootstrap($spec->{bs_file}); # Original had $BSLOADLIBS - what's that?
- {my $fh = IO::File->new(">> $spec->{bs_file}")} # create
+ open(my $fh, '>>', $spec->{bs_file}); # create
utime((time)x2, $spec->{bs_file}); # touch
}
https://perl5.git.perl.org / perl5.git / blobdiff