cpan/Module-Build/t/00-compile.t
cpan/Module-Build/t/actions/installdeps.t
cpan/Module-Build/t/actions/manifest_skip.t
+cpan/Module-Build/t/add_property_array.t
+cpan/Module-Build/t/add_property_hash.t
cpan/Module-Build/t/add_property.t
cpan/Module-Build/t/basic.t
cpan/Module-Build/t/bundled/Software/License.pm
cpan/Module-Build/t/lib/Module/Signature.pm
cpan/Module-Build/t/lib/Software/License/VaporWare.pm
cpan/Module-Build/t/manifypods.t
+cpan/Module-Build/t/manifypods_with_utf8.t
cpan/Module-Build/t/metadata2.t
cpan/Module-Build/t/metadata.t
cpan/Module-Build/t/mymeta.t
cpan/Module-Build/t/test_types.t
cpan/Module-Build/t/test_type.t
cpan/Module-Build/t/tilde.t
+cpan/Module-Build/t/unit_run_test_harness.t
cpan/Module-Build/t/use_tap_harness.t
cpan/Module-Build/t/versions.t
cpan/Module-Build/t/write_default_maniskip.t
Revision history for Perl extension Module::Build.
+0.4007 - Fri Jul 19 13:44:39 CEST 2013
+
+ [BUG FIXES]
+
+ - Removed undeclared test dependency on parent.pm [Leon Timmermans]
+
+ - Declared dependency on Pod::Man 2.17 for utf8 support [Leon Timmermans]
+
+ - Force generation of man pages in manify_with_utf8.t [Leon Timmermans]
+
+0.4006 - Thu Jul 18 14:19:49 CEST 2013
+
+ [ENHANCEMENTS]
+
+ - Significantly sped up some tests by not forcing HTML docs to be
+ built when the user's config doesn't ask for them anyway.
+ [Ken Williams]
+
+ - The Module::Metadata package was split out from this distro back
+ in 2010. Removed its regression tests. [Ken Williams]
+
+ - Removed dependence on IO::File, replacing it with safe invocations
+ of open(). [Sven Dowideit]
+
+ - Added an 'extra_manify_args' parameter to facilitate man pages
+ containing Unicode. [Joenio Costa]
+
+ - Added an '--html_links 0' argument for the 'html' action, which
+ can hugely speed things up. The main effect is speeding up the
+ M::B tests themselves. [Ken Williams]
+
+ [BUG FIXES]
+
+ - Fix hash argument parsing in subclasses [Graham Ollis]
+
+ - Revised detildification on VMS [Craig Berry]
+
+ - Fix run_test_harness for case when $Switches is an empty string
+ [Victor Efimov, Ken Williams]
+
0.4005 - Thu Apr 25 15:10:14 CEST 2013
[ENHANCEMENTS]
package Module::Build;
+use if $] >= 5.019, 'deprecate';
+
# This module doesn't do much of anything itself, it inherits from the
# modules that do the real work. The only real thing it has to do is
# figure out which OS-specific module to pull in. Many of the
use vars qw($VERSION @ISA);
@ISA = qw(Module::Build::Base);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
-
# Inserts the given module into the @ISA hierarchy between
# Module::Build and its immediate parent
sub _interpose_module {
module through subclassing in a much more straightforward way than
with C<MakeMaker>. It also does not require a C<make> on your system
- most of the C<Module::Build> code is pure-perl and written in a very
-cross-platform way. In fact, you don't even need a shell, so even
-platforms like MacOS (traditional) can use it fairly easily. Its only
-prerequisites are modules that are included with perl 5.6.0, and it
-works fine on perl 5.005 if you can install a few additional modules.
+cross-platform way.
See L<"MOTIVATIONS"> for more comparisons between C<ExtUtils::MakeMaker>
and C<Module::Build>.
command line by specifying C<install_path> values for the C<binhtml>
and/or C<libhtml> installation targets.
+With an optional C<html_links> argument set to a false value, you can
+skip the search for other documentation to link to, because that can
+waste a lot of time if there aren't any links to generate anyway:
+
+ ./Build html --html_links 0
+
=item install
[version 0.01]
When Module::Build starts up, it will look first for a file,
F<$ENV{HOME}/.modulebuildrc>. If it's not found there, it will look
-in the the F<.modulebuildrc> file in the directories referred to by
+in the F<.modulebuildrc> file in the directories referred to by
the environment variables C<HOMEDRIVE> + C<HOMEDIR>, C<USERPROFILE>,
C<APPDATA>, C<WINDIR>, C<SYS$LOGIN>. If the file exists, the options
specified there will be used as defaults, as if they were typed on the
extra_linker_flags => scalar `glib-config --libs`,
);
+=item extra_manify_args
+
+[version 0.4006]
+
+Any extra arguments to pass to C<< Pod::Man->new() >> when building
+man pages. One common choice might be C<< utf8 => 1 >> to get Unicode
+support.
+
=item get_options
[version 0.26]
command line options to F<Build.PL> or F<Build>, minus the Module-Build
specific options.
-When called in in a scalar context with no arguments, this method returns a
+When called in a scalar context with no arguments, this method returns a
reference to the hash storing all of the arguments; in an array context, it
returns the hash itself. When passed a single argument, it returns the value
stored in the args hash for that option key. When called with two arguments,
=item dynamic_config()
+=item extra_manify_args()
+
=item get_options()
=item html_css()
If you would like to add other useful metadata, C<Module::Build>
supports this with the C<meta_add> and C<meta_merge> arguments to
L</new()>. The authoritative list of supported metadata can be found at
-L<CPAN::META::Spec> but for convenience - here are a few of the more useful ones:
+L<CPAN::Meta::Spec> but for convenience - here are a few of the more useful ones:
=over 4
use vars qw($VERSION);
use warnings;
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
BEGIN { require 5.006001 }
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) = @_;
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 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;
}
$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;
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
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::verbose,
+ $Test::Harness::Verbose,
+ $ENV{TEST_VERBOSE},
+ $ENV{HARNESS_VERBOSE}) = ($p->{verbose} || 0) x 4;
+
+ my @harness_switches = $self->harness_switches;
+ return Test::Harness::runtests(@$tests) unless @harness_switches; # Nothing to modify
+
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;
+ $Test::Harness::Switches = undef unless defined $Test::Harness::Switches and 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;
-
Test::Harness::runtests(@$tests);
}
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);
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 = File::Spec->catdir(File::Spec->updir x @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" );
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;
}
@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
}
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
use File::Basename ();
use File::Spec;
-use IO::File;
use Config;
use Module::Build;
use Module::Build::ModuleInfo;
$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}: $!";
+ open($fh, '>', "$args{file}") or die "Can't write $args{file}: $!";
}
print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";
sub fake_prereqs {
my $file = File::Spec->catfile('_build', 'prereqs');
- my $fh = IO::File->new("< $file") or die "Can't read $file: $!";
+ open(my $fh, '<', "$file") or die "Can't read $file: $!";
my $prereqs = eval do {local $/; <$fh>};
close $fh;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use 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
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: $!";
+ open(my $fh, '+<', $me) or die "Can't rewrite $me: $!";
seek($fh, 0, 0);
while (<$fh>) {
last if /^__DATA__$/;
seek($fh, tell($fh), 0);
my $data = [$config, $features, $auto_features];
- $fh->print( 'do{ my '
+ print($fh 'do{ my '
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
. '$x; }' );
truncate($fh, tell($fh));
- $fh->close;
+ close $fh;
chmod($mode_orig, $me)
or warn "Couldn't restore permissions on $me: $!";
'description' => 'Create Unix man pages'
},
'PPM_support' => {
- 'requires' => {
- 'IO::File' => '1.13'
- },
'description' => 'Generate PPM files for distributions'
},
'dist_authoring' => {
package Module::Build::Cookbook;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
=head1 NAME
package Module::Build::Dumper;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
# This is just a split-out of a wrapper function to do Data::Dumper
# stuff "the right way". See:
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
require Module::Metadata;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Data::Dumper;
-use IO::File;
use Module::Build::Dumper;
sub new {
sub restore {
my $self = shift;
- my $fh = IO::File->new("< $self->{file}") or die "Can't read $self->{file}: $!";
+ open(my $fh, '<', $self->{file}) or die "Can't read $self->{file}: $!";
$self->{disk} = eval do {local $/; <$fh>};
die $@ if $@;
+ close $fh;
$self->{new} = {};
}
sub _dump {
my ($self, $file, $data) = @_;
- my $fh = IO::File->new("> $file") or die "Can't create '$file': $!";
+ open(my $fh, '>', $file) or die "Can't create '$file': $!";
print {$fh} Module::Build::Dumper->_data_dump($data);
+ close $fh;
}
my $orig_template = do { local $/; <DATA> };
# recognized for *this* source file
$template =~ s{$_\n}{} for '=begin private', '=end private';
- my $fh = IO::File->new("> $args{file}") or die "Can't create '$args{file}': $!";
+ open(my $fh, '>', $args{file}) or die "Can't create '$args{file}': $!";
print {$fh} $template;
print {$fh} "\n__DATA__\n";
print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]);
-
+ close $fh;
}
1;
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
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: $!";
+ open(my $fh, '+<', $me) or die "Can't rewrite $me: $!";
seek($fh, 0, 0);
while (<$fh>) {
last if /^__DATA__$/;
seek($fh, tell($fh), 0);
my $data = [$config, $features, $auto_features];
- $fh->print( 'do{ my '
+ print($fh 'do{ my '
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
. '$x; }' );
truncate($fh, tell($fh));
- $fh->close;
+ close $fh;
chmod($mode_orig, $me)
or warn "Couldn't restore permissions on $me: $!";
use strict;
use Config;
use vars qw($VERSION);
-use IO::File;
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
EOF
my $ppd_file = "$dist{name}.ppd";
- my $fh = IO::File->new(">$ppd_file")
+ open(my $fh, '>', $ppd_file)
or die "Cannot write to $ppd_file: $!";
- my $io_file_ok = eval { IO::File->VERSION(1.13); 1 };
- $fh->binmode(":utf8")
- if $io_file_ok && $fh->can('binmode') && $] >= 5.008 && $Config{useperlio};
+ binmode($fh, ":utf8")
+ if $] >= 5.008 && $Config{useperlio};
print $fh $ppd;
close $fh;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Base;
use vars qw(@ISA);
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Base;
use Config;
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);
+ unless ($arg =~ m#^~/#) {
+ # There is a home directory after the tilde, but it will already
+ # be present in in @hdirs so we need to remove it by from @dirs.
+ shift @dirs;
}
+ my $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
- # Now put the two cases back together
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
-
}
return $arg;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Base;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Config;
use File::Basename;
use File::Spec;
-use IO::File;
use Module::Build::Base;
my $null_arg = (Win32::IsWinNT()) ? '""' : '';
my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");
- my $fh = IO::File->new(">> $basename.bat")
+ open(my $fh, '>>', "$basename.bat")
or die "Can't create $basename.bat: $!";
print $fh $cmd;
close $fh ;
my $start = $Config{startperl};
$start = "#!perl" unless $start =~ /^#!.*perl/;
- my $in = IO::File->new("< $opts{in}") or die "Can't open $opts{in}: $!";
+ open(my $in, '<', "$opts{in}") or die "Can't open $opts{in}: $!";
my @file = <$in>;
- $in->close;
+ close($in);
foreach my $line ( @file ) {
$linenum++;
}
}
- my $out = IO::File->new("> $opts{out}") or die "Can't open $opts{out}: $!";
+ open(my $out, '>', "$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;
+ close($out);
return $opts{out};
}
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Module::Build::Platform::Unix;
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use vars qw(@ISA);
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}: $!";
+ open($self->{fh}, '<', $self->{file}) or die "Couldn't open $self->{file}: $!";
}
return $self;
while (<$fh>) {
next unless /^=(?!cut)/ .. /^=cut/; # in POD
# Accept Name - abstract or C<Name> - abstract
- last if ($self->{abstract}) = /^ (?: [a-z0-9:]+ | [BCIF] < [a-z0-9:]+ > ) \s+ - \s+ (.*\S) /ix;
+ last if ($self->{abstract}) = /^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix;
}
my @author;
package inc::latest;
+
+use if $] >= 5.019, 'deprecate';
+
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use Carp;
use File::Basename ();
use File::Spec ();
use File::Path ();
-use IO::File ();
use File::Copy ();
# track and return modules loaded by inc::latest
# write inc/latest.pm
File::Path::mkpath( $where );
- my $fh = IO::File->new( File::Spec->catfile($where,'latest.pm'), "w" );
+ open my $fh, '>', File::Spec->catfile($where,'latest.pm');
print {$fh} "# This stub created by inc::latest $VERSION\n";
print {$fh} <<'HERE';
package inc::latest;
package inc::latest::private;
+
+use if $] >= 5.019, 'deprecate';
+
use strict;
use vars qw($VERSION);
-$VERSION = '0.4005';
+$VERSION = '0.4007';
$VERSION = eval $VERSION;
use File::Spec;
-use IO::File;
# must ultimately "goto" the import routine of the module to be loaded
# so that the calling package is correct when $mod->import() runs.
my $mypath = 'inc';
- local *DH; # Maintain 5.005 compatibility
- opendir DH, $mypath or die "Can't open directory $mypath: $!";
+ opendir my $DH, $mypath or die "Can't open directory $mypath: $!";
- while (defined(my $e = readdir DH)) {
+ while (defined(my $e = readdir $DH)) {
next unless $e =~ /^inc_/;
my $try = File::Spec->catfile($mypath, $e, $file);
isa_ok( $mb, "Module::Build" );
like( $mb->cpan_client, qr/^\Q$^X\E/, "cpan_client is mocked with perl" );
+my $retval;
my $out = stdout_of( sub {
- $dist->run_build('installdeps')
+ $retval = $mb->dispatch('installdeps')
});
-ok( length($out), "ran mocked Build installdeps");
+ok( $retval, "ran mocked Build installdeps");
like( $out, qr/File::Spec/, "saw File::Spec prereq" );
like( $out, qr/Getopt::Long/, "saw Getopt::Long prereq" );
$out = stdout_stderr_of( sub {
- $dist->run_build('installdeps', '--cpan_client', 'ADLKASJDFLASDJ')
+ $retval = $mb->dispatch('installdeps', cpan_client => 'ADLKASJDFLASDJ');
});
-like( $out, qr/cpan_client .* is not executable/,
- "Build installdeps with bad cpan_client dies"
-);
+ok( !$retval, "Build installdeps with bad cpan_client fails" );
# vim:ts=2:sw=2:et:sta:sts=2
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't/lib';
+use MBTest tests => 1;
+
+blib_load 'Module::Build';
+
+ADDPROP: {
+ package My::Build::Prop;
+ use base 'Module::Build';
+ __PACKAGE__->add_property( 'list_property' => []);
+}
+
+ok grep { $_ eq 'bundle_inc' } My::Build::Prop->array_properties, "has bundle_inc even after adding another array property";
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't/lib';
+use MBTest tests => 1;
+
+blib_load 'Module::Build';
+
+ADDPROP: {
+ package My::Build::Prop;
+ use base 'Module::Build';
+ __PACKAGE__->add_property( 'hash_property' => {});
+}
+
+ok grep { $_ eq 'install_path' } My::Build::Prop->hash_properties, "has install_path even after adding another hash property";
+
use MBTest; # or 'no_plan'
use DistGen;
use Config;
-use IO::File;
use File::Spec;
use ExtUtils::Packlist;
use ExtUtils::Installed;
# we can't edit the file.
eval {
- my $fh;
chmod 0666, $mb_file;
- $fh = IO::File->new($mb_file, "<") or die "Could not read $mb_file: $!";
+ open(my $fh, '<', $mb_file) or die "Could not read $mb_file: $!";
my $mb_code = do { local $/; <$fh> };
$mb_code =~ s{\$VERSION\s+=\s+\S+}{\$VERSION = 9999;};
- $fh->close;
- $fh = IO::File->new($mb_file, ">") or die "Could not write $mb_file: $!";
+ close $fh;
+ open($fh, '>', $mb_file) or die "Could not write $mb_file: $!";
print {$fh} $mb_code;
- $fh->close;
+ close $fh;
};
my $err = $@;
stdout_of( sub { Module::Build->run_perl_script('Build.PL',[],[]) } );
ok( -e 'MYMETA.yml', 'MYMETA was created' );
- my $meta = IO::File->new('MYMETA.yml');
+ open(my $meta, '<', 'MYMETA.yml');
ok( $meta, "opened MYMETA.yml" );
ok( scalar( grep { /generated_by:.*9999/ } <$meta> ),
"dist_dir Build.PL loaded bundled Module::Build"
use lib 't/lib';
use MBTest;
use File::Spec;
-use IO::File;
use Config;
# Don't let our own verbosity/test_file get mixed up with our subprocess's
}
sub find_params_in_makefile {
- my $fh = IO::File->new( $makefile, 'r' )
+ open(my $fh, '<', $makefile )
or die "Can't read $makefile: $!";
local($/) = "\n";
blib_load('Module::Build');
-use IO::File;
my $tmp = MBTest->tmpdir;
use DistGen;
my $filename = 'file with spaces.txt';
my $file = File::Spec->catfile($tmp[0], $filename);
- my $fh = IO::File->new($file, '>') or die "Can't create $file: $!";
+ open(my $fh, '>', $file) or die "Can't create $file: $!";
print $fh "Foo\n";
- $fh->close;
+ close $fh;
ok -e $file;
use strict;
use lib 't/lib';
-use MBTest tests => 35;
+use MBTest tests => 34;
blib_load('Module::Build');
use File::Spec::Functions qw( catdir );
my $mb = Module::Build->new_from_context(
- # need default install paths to ensure manpages & HTML get generated
+ # Need default install paths to ensure manpages get generated.
installdirs => 'site',
config => {
installman1dir => catdir($tmp, 'man', 'man1'),
installman3dir => catdir($tmp, 'man', 'man3'),
- installhtml1dir => catdir($tmp, 'html'),
- installhtml3dir => catdir($tmp, 'html'),
-
installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'),
installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'),
- installsitehtml1dir => catdir($tmp, 'site', 'html'),
- installsitehtml3dir => catdir($tmp, 'site', 'html'),
+ ## We also used to have HTML paths here, but building HTML docs
+ ## can be super slow, and we never checked the result anyway.
}
);
'--install_base', $basedir])};
is $@, '';
- eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir,
- '--install_base', $basedir, '--install_base', $basedir])};
- is $@, '';
-
$install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) . '.pm';
is -e $install_to, 1, "Look for file at $install_to";
use File::Find ();
use File::Path ();
use File::Spec ();
-use IO::File ();
use Tie::CPHash;
use Data::Dumper;
my $self = shift;
my $manifest = shift;
- my $fh = IO::File->new( ">$manifest" ) or do {
+ open(my $fh, '>', $manifest ) or do {
die "Can't write '$manifest'\n";
};
1 while unlink( $fullname );
}
- my $fh = IO::File->new(">$fullname") or do {
+ open(my $fh, '>', $fullname) or do {
die "Can't write '$fullname'\n";
};
print $fh $self->{filedata}{$file};
use strict;
-use IO::File ();
use File::Spec;
use File::Temp ();
use File::Path ();
}
sub slurp {
- my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!";
+ open(my $fh, '<', $_[0]) or die "Can't open $_[0]: $!";
local $/;
return scalar <$fh>;
}
scripts => [ File::Spec->catfile( 'bin', 'nopod.pl' ),
File::Spec->catfile( 'bin', 'haspod.pl' ) ],
- # need default install paths to ensure manpages & HTML get generated
+ # Need default install paths to ensure manpages get generated
installdirs => 'site',
config => {
installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'),
installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'),
- installsitehtml1dir => catdir($tmp, 'site', 'html'),
- installsitehtml3dir => catdir($tmp, 'site', 'html'),
}
);
--- /dev/null
+package ManifypodsWithUtf8;
+use strict;
+use utf8;
+use Test::More;
+
+use lib 't/lib';
+blib_load('Module::Build');
+blib_load('Module::Build::ConfigData');
+
+SKIP: {
+ unless ( Module::Build::ConfigData->feature('manpage_support') ) {
+ skip 'manpage_support feature is not enabled';
+ }
+}
+
+use MBTest tests => 2;
+use File::Spec::Functions qw( catdir );
+
+use Cwd ();
+my $cwd = Cwd::cwd;
+my $tmp = MBTest->tmpdir;
+
+use DistGen;
+my $dist = DistGen->new( dir => $tmp );
+my $content = <<'---';
+
+=encoding utf8
+
+=head1 NAME
+
+Simple::PodWithUtf8 - POD with some (ç á à ô) special chars
+
+=cut
+---
+utf8::encode($content);
+$dist->add_file( 'lib/Simple/PodWithUtf8.pod', $content);
+$dist->regen;
+$dist->chdir_in;
+
+my $destdir = catdir($cwd, 't', 'install_test' . $$);
+
+my $mb = Module::Build->new(
+ module_name => $dist->name,
+ install_base => $destdir,
+
+ # need default install paths to ensure manpages get generated
+ installdirs => 'site',
+ config => {
+ installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'),
+ installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'),
+ },
+ extra_manify_args => { utf8 => 1 },
+ );
+$mb->add_to_cleanup($destdir);
+
+
+$mb->dispatch('build');
+my $sep = $mb->manpage_separator;
+my $ext3 = $mb->config('man3ext');
+my $to = File::Spec->catfile('blib', 'libdoc', "Simple${sep}PodWithUtf8.${ext3}");
+
+ok(-e $to, "Manpage is found at $to");
+open my $pod, '<:encoding(utf-8)', $to or diag "Could not open $to: $!";
+my $pod_content = do { local $/; <$pod> };
+close $pod;
+
+like($pod_content, qr/ \(ç á à ô\) /, "POD should contain special characters");
+
use strict;
use lib 't/lib';
-use MBTest tests => 52;
+use MBTest tests => 14;
blib_load('Module::Build');
blib_load('Module::Build::ConfigData');
dist_author => [ 'Simple Simon <ss\@somewhere.priv>' ],
dist_abstract => 'Something interesting',
test_requires => {
- 'Test::More' => 0.98,
+ 'Test::More' => 0.49,
},
license => 'perl',
meta_add => {
is $node->{license}, $metadata{license};
is_deeply $node->{configure_requires}, $mb_config_req, 'Add M::B to configure_requires';
is_deeply $node->{test_requires}, {
- 'Test::More' => '0.98',
+ 'Test::More' => '0.49',
}, 'Test::More was required by ->new';
like $node->{generated_by}, qr{Module::Build};
ok defined( $node->{'meta-spec'}{version} ),
$dist->clean;
-
-##################################################
-#
-# Tests to ensure that the correct packages and versions are
-# recorded for the 'provides' field of META.yml
-
-my $provides; # Used a bunch of times below
-
-sub new_build { return Module::Build->new_from_context( quiet => 1, @_ ) }
-
-############################## Single Module
-
-# File with corresponding package (w/ or w/o version)
-# Simple.pm => Simple v1.23
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => {file => $simple_file,
- version => '1.23'}});
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => {file => $simple_file}});
-
-# File with no corresponding package (w/ or w/o version)
-# Simple.pm => Foo::Bar v1.23
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo::Bar;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Foo::Bar' => { file => $simple_file,
- version => '1.23' }});
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo::Bar;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Foo::Bar' => { file => $simple_file}});
-
-
-# Single file with multiple differing packages (w/ or w/o version)
-# Simple.pm => Simple
-# Simple.pm => Foo::Bar
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
-package Foo::Bar;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple_file,
- version => '1.23' },
- 'Foo::Bar' => { file => $simple_file,
- version => '1.23' }});
-
-{
- $dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]);
-package Simple::Simon;
-$VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]);
----
- $dist->regen;
- my $provides = new_build()->get_metadata()->{provides};
- is $provides->{'Simple'}{version}, 'v0.60.128', "Check version";
- is $provides->{'Simple::Simon'}{version}, 'v0.61.129', "Check version";
- is ref($provides->{'Simple'}{version}), '', "Versions from get_metadata() aren't refs";
- is ref($provides->{'Simple::Simon'}{version}), '', "Versions from get_metadata() aren't refs";
-}
-
-
-# Single file with multiple differing packages, no corresponding package
-# Simple.pm => Foo
-# Simple.pm => Foo::Bar
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
-$VERSION = '1.23';
-package Foo::Bar;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Foo' => { file => $simple_file,
- version => '1.23' },
- 'Foo::Bar' => { file => $simple_file,
- version => '1.23' }});
-
-
-# Single file with same package appearing multiple times, no version
-# only record a single instance
-# Simple.pm => Simple
-# Simple.pm => Simple
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-package Simple;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple_file }});
-
-
-# Single file with same package appearing multiple times, single
-# version 1st package:
-# Simple.pm => Simple v1.23
-# Simple.pm => Simple
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
-package Simple;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-
-
-# Single file with same package appearing multiple times, single
-# version 2nd package
-# Simple.pm => Simple
-# Simple.pm => Simple v1.23
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-package Simple;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-
-
-# Single file with same package appearing multiple times, conflicting versions
-# Simple.pm => Simple v1.23
-# Simple.pm => Simple v2.34
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
-package Simple;
-$VERSION = '2.34';
----
-$dist->regen( clean => 1 );
-my $err = '';
-$err = stderr_of( sub { $mb = new_build() } );
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-is_deeply($provides,
- {'Simple' => { file => $simple_file,
- version => '1.23' }}); # XXX should be 2.34?
-
-
-# (Same as above three cases except with no corresponding package)
-# Simple.pm => Foo v1.23
-# Simple.pm => Foo v2.34
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
-$VERSION = '1.23';
-package Foo;
-$VERSION = '2.34';
----
-$dist->regen( clean => 1 );
-$err = stderr_of( sub { $mb = new_build() } );
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-is_deeply($provides,
- {'Foo' => { file => $simple_file,
- version => '1.23' }}); # XXX should be 2.34?
-
-# Missing version should not show up in provides as version "0"
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
-$VERSION = undef;
-1;
----
-$dist->regen( clean => 1 );
-$err = stderr_of( sub { $mb = new_build() } );
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-is_deeply($provides,
- {'Foo' => { file => $simple_file } },
- "undef \$VERSION is omitted from 'provides'"
-);
-
-############################## Multiple Modules
-
-# Multiple files with same package, no version
-# Simple.pm => Simple
-# Simple2.pm => Simple
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Simple;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple_file }});
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package, single version in corresponding package
-# Simple.pm => Simple v1.23
-# Simple2.pm => Simple
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Simple;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package,
-# single version in non-corresponding package
-# Simple.pm => Simple
-# Simple2.pm => Simple v1.23
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple2_file,
- version => '1.23' }});
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package, conflicting versions
-# Simple.pm => Simple v1.23
-# Simple2.pm => Simple v2.34
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Simple;
-$VERSION = '2.34';
----
-$dist->regen( clean => 1 );
-stderr_of( sub { $mb = new_build(); } );
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-is_deeply($provides,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-like( $err, qr/Found conflicting versions for package/,
- ' with conflicting versions reported' );
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package, multiple agreeing versions
-# Simple.pm => Simple v1.23
-# Simple2.pm => Simple v1.23
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-is_deeply($provides,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-############################################################
-#
-# (Same as above five cases except with non-corresponding package)
-#
-
-# Multiple files with same package, no version
-# Simple.pm => Foo
-# Simple2.pm => Foo
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Foo;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-$provides = $mb->find_dist_packages;
-ok( exists( $provides->{Foo} ) ); # it exist, can't predict which file
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package, version in first file
-# Simple.pm => Foo v1.23
-# Simple2.pm => Foo
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Foo;
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Foo' => { file => $simple_file,
- version => '1.23' }});
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package, version in second file
-# Simple.pm => Foo
-# Simple2.pm => Foo v1.23
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Foo;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Foo' => { file => $simple2_file,
- version => '1.23' }});
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package, conflicting versions
-# Simple.pm => Foo v1.23
-# Simple2.pm => Foo v2.34
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Foo;
-$VERSION = '2.34';
----
-$dist->regen( clean => 1 );
-stderr_of( sub { $mb = new_build(); } );
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-# XXX Should 'Foo' exist ??? Can't predict values for file & version
-ok( exists( $provides->{Foo} ) );
-like( $err, qr/Found conflicting versions for package/,
- ' with conflicting versions reported' );
-$dist->remove_file( 'lib/Simple2.pm' );
-
-
-# Multiple files with same package, multiple agreeing versions
-# Simple.pm => Foo v1.23
-# Simple2.pm => Foo v1.23
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Foo;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Foo;
-$VERSION = '1.23';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-ok( exists( $provides->{Foo} ) );
-is( $provides->{Foo}{version}, '1.23' );
-ok( exists( $provides->{Foo}{file} ) ); # Can't predict which file
-is( $err, '', ' no conflicts reported' );
-$dist->remove_file( 'lib/Simple2.pm' );
-
-############################################################
-# Conflicts among primary & multiple alternatives
-
-# multiple files, conflicting version in corresponding file
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Simple;
-$VERSION = '2.34';
----
-$dist->add_file( 'lib/Simple3.pm', <<'---' );
-package Simple;
-$VERSION = '2.34';
----
-$dist->regen( clean => 1 );
-$err = stderr_of( sub {
- $mb = new_build();
-} );
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-is_deeply($provides,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-like( $err, qr/Found conflicting versions for package/,
- ' corresponding package conflicts with multiple alternatives' );
-$dist->remove_file( 'lib/Simple2.pm' );
-$dist->remove_file( 'lib/Simple3.pm' );
-
-# multiple files, conflicting version in non-corresponding file
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple2.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
----
-$dist->add_file( 'lib/Simple3.pm', <<'---' );
-package Simple;
-$VERSION = '2.34';
----
-$dist->regen( clean => 1 );
-$err = stderr_of( sub {
- $mb = new_build();
-} );
-$err = stderr_of( sub { $provides = $mb->find_dist_packages } );
-is_deeply($provides,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-like( $err, qr/Found conflicting versions for package/,
- ' only one alternative conflicts with corresponding package' );
-$dist->remove_file( 'lib/Simple2.pm' );
-$dist->remove_file( 'lib/Simple3.pm' );
-
-
-############################################################
-# Don't record private packages (beginning with underscore)
-# Simple.pm => Simple::_private
-# Simple.pm => Simple::_private::too
-
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-package Simple;
-$VERSION = '1.23';
-package Simple::_private;
-$VERSION = '2.34';
-package Simple::_private::too;
-$VERSION = '3.45';
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages,
- {'Simple' => { file => $simple_file,
- version => '1.23' }});
-
-
-############################################################
-# Files with no packages?
-
-# Simple.pm => <empty>
-
-$dist->change_file( 'lib/Simple.pm', '' );
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply( $mb->find_dist_packages, {} );
-
-# Simple.pm => =pod..=cut (no package declaration)
-$dist->change_file( 'lib/Simple.pm', <<'---' );
-=pod
-
-=head1 NAME
-
-Simple - Pure Documentation
-
-=head1 DESCRIPTION
-
-Doesn't do anything.
-
-=cut
----
-$dist->regen( clean => 1 );
-$mb = new_build();
-is_deeply($mb->find_dist_packages, {});
-
blib_load('Module::Build');
-use IO::File;
my $tmp = MBTest->tmpdir;
use DistGen;
use strict;
use lib 't/lib';
-use MBTest tests => 12;
+use MBTest tests => 14;
blib_load('Module::Build::PodParser');
is $pp->get_author->[0], 'C<Foo::Bar> was written by Engelbert Humperdinck I<E<lt>eh@example.comE<gt>> in 2004.', 'author';
is $pp->get_abstract, 'Perl extension for blah blah blah', 'abstract';
}
+
+{
+local *FH;
+tie *FH, 'IO::StringBased', <<'EOF';
+=head1 NAME
+
+Foo_Bar - Perl extension for eating pie
+
+=head1 AUTHOR
+
+C<Foo_Bar> was written by Engelbert Humperdinck I<E<lt>eh@example.comE<gt>> in 2004.
+
+Home page: http://example.com/~eh/
+
+=cut
+EOF
+
+
+ my $pp = Module::Build::PodParser->new(fh => \*FH);
+ ok $pp, 'object created';
+ is $pp->get_abstract, 'Perl extension for eating pie', 'abstract';
+}
( installsitehtml1dir => catdir($tmp, 'site', 'html'),
installsitehtml3dir => catdir($tmp, 'site', 'html') ) : () ),
},
+ html_links => 0,
);
installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'),
installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'),
},
+ html_links => 0,
);
$mb->dispatch('ppmdist');
ok ! -e File::Spec->catdir('Simple-0.01', 'blib');
# Make sure all of the above was done by the new version of Module::Build
- my $fh = IO::File->new(File::Spec->catfile($dist->dirname, 'META.yml'));
+ open(my $fh, '<', File::Spec->catfile($dist->dirname, 'META.yml'));
my $contents = do {local $/; <$fh>};
$contents =~ /Module::Build version ([0-9_.]+)/m;
cmp_ok $1, '==', $mb->VERSION, "Check version used to create META.yml: $1 == " . $mb->VERSION;
SKIP: {
skip("We do not rewrite shebang on VMS", 1) if $^O eq 'VMS';
- my $fh = IO::File->new($blib_script);
+ open(my $fh, '<', $blib_script);
my $first_line = <$fh>;
isnt $first_line, "#!perl -w\n", "should rewrite the shebang line";
}
or !defined $info[7] or !defined $info[0];
my ($me, $home) = @info[0,7];
- my $expected = "$home/fooxzy";
-
if ($^O eq 'VMS') {
- # Convert the path to UNIX format and trim off the trailing slash
- $home = VMS::Filespec::unixify($home);
+ # Convert the path to UNIX format and trim off the trailing slash.
+ # Also, the fake module we're in has mangled $ENV{HOME} for its own
+ # purposes; getpwuid doesn't know about that but _detildefy does.
+ $home = VMS::Filespec::unixify($ENV{HOME});
$home =~ s#/$##;
- $expected = $home . '/../[^/]+' . '/fooxzy';
}
+ my $expected = "$home/fooxzy";
like( run_sample( $p => "~$me/fooxzy")->$p(), qr(\Q$expected\E)i );
}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't/lib';
+use MBTest tests => 9;
+
+blib_load('Module::Build');
+
+my $tmp = MBTest->tmpdir;
+
+use DistGen;
+my $dist = DistGen->new( dir => $tmp );
+$dist->regen;
+
+$dist->chdir_in;
+
+#########################
+
+
+# make sure Test::Harness loaded before we define Test::Harness::runtests otherwise we'll
+# get another redefined warning inside Test::Harness::runtests
+use Test::Harness;
+
+{
+ package MB::Subclass;
+ use base qw(Module::Build);
+ sub harness_switches { }
+}
+
+{
+ local $SIG{__WARN__} = sub { die "Termination after a warning: $_[0]"};
+ my $mock1 = { A => 1 };
+ my $mock2 = { B => 2 };
+
+ no warnings qw[redefine once];
+
+ # This runs run_test_harness with Test::Harness::switches = undef and harness_switches() returning empty list,
+ # ensure there are no warnings, and output is undef too
+ {
+ my $mb = MB::Subclass->new( module_name => $dist->name );
+ local *Test::Harness::runtests = sub {
+ is shift(), $mock1, "runtests ran with expected parameters";
+ is shift(), $mock2, "runtests ran with expected parameters";
+ is $Test::Harness::switches, undef, "switches are undef";
+ is $Test::Harness::Switches, undef, "switches are undef";
+ };
+
+ # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this
+ local $Test::Harness::switches = undef;
+ local $Test::Harness::switches = undef;
+ $mb->run_test_harness([$mock1, $mock2]);
+
+ ok 1, "run_test_harness should not produce warning if Test::Harness::[Ss]witches are undef and harness_switches() return empty list";
+ }
+
+ # This runs run_test_harness with Test::Harness::switches = '' and harness_switches() returning empty list,
+ # ensure there are no warnings, and switches are empty string
+ {
+ my $mb = MB::Subclass->new( module_name => $dist->name );
+ local *Test::Harness::runtests = sub {
+ is shift(), $mock1, "runtests ran with expected parameters";
+ is shift(), $mock2, "runtests ran with expected parameters";
+ is $Test::Harness::switches, '', "switches are empty string";
+ is $Test::Harness::Switches, '', "switches are empty string";
+ };
+
+ # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this
+ local $Test::Harness::switches = '';
+ local $Test::Harness::switches = '';
+ $mb->run_test_harness([$mock1, $mock2]);
+ }
+
+}
-Module::Build cpan/Module-Build/lib/Module/Build/ConfigData.pm 2f3f07fd889077ebd51791ad6e195d9164b4baf3
+Module::Build cpan/Module-Build/lib/Module/Build/ConfigData.pm 409075121c3a50488052df00e5cdeeeb5594409a
Test::Harness cpan/Test-Harness/t/source.t 884890970fb850874213159df263ba483bac62e9
Test::Simple cpan/Test-Simple/t/fail-more.t 851583390f26786131535e2837dae1113d72c41a
Text::Balanced cpan/Text-Balanced/t/01_compile.t 1598cf491a48fa546260a2ec41142abe84da533d
https://perl5.git.perl.org / perl5.git / commitdiff