diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2013-07-22 09:41:01 +0100 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2013-07-22 11:12:21 +0100 |
commit | 46de787b36986f74e850d2f1c95ddccc1ef7ce7d (patch) | |
tree | 08cae80de0fe6208855ec60e1756f052fbf5c515 /cpan | |
parent | dd0df890d83ec74c796280919915491bb8e05104 (diff) | |
download | perl-46de787b36986f74e850d2f1c95ddccc1ef7ce7d.tar.gz |
Update Module-Build to CPAN version 4.007
[DELTA]
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]
Diffstat (limited to 'cpan')
43 files changed, 456 insertions, 747 deletions
diff --git a/cpan/Module-Build/Changes b/cpan/Module-Build/Changes index fc37e212ed..6ac7ac0187 100644 --- a/cpan/Module-Build/Changes +++ b/cpan/Module-Build/Changes @@ -1,5 +1,45 @@ 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] diff --git a/cpan/Module-Build/lib/Module/Build.pm b/cpan/Module-Build/lib/Module/Build.pm index 3c964e7786..fff5db6369 100644 --- a/cpan/Module-Build/lib/Module/Build.pm +++ b/cpan/Module-Build/lib/Module/Build.pm @@ -1,5 +1,7 @@ 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 @@ -16,10 +18,9 @@ use Module::Build::Base; 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 { @@ -94,10 +95,7 @@ C<ExtUtils::MakeMaker>. Developers may alter the behavior of the 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>. @@ -379,6 +377,12 @@ C<Config.pm>. You can also supply or override install paths on the 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] @@ -747,7 +751,7 @@ executed build actions. 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 diff --git a/cpan/Module-Build/lib/Module/Build/API.pod b/cpan/Module-Build/lib/Module/Build/API.pod index 2810c2ba32..f68fdf71ac 100644 --- a/cpan/Module-Build/lib/Module/Build/API.pod +++ b/cpan/Module-Build/lib/Module/Build/API.pod @@ -395,6 +395,14 @@ To link your XS code against glib you might write something like: 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] @@ -1082,7 +1090,7 @@ This method is the preferred interface for retrieving the arguments passed via 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, @@ -1984,6 +1992,8 @@ accessor methods for the following properties: =item dynamic_config() +=item extra_manify_args() + =item get_options() =item html_css() @@ -2071,7 +2081,7 @@ accessor methods for the following properties: 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 diff --git a/cpan/Module-Build/lib/Module/Build/Base.pm b/cpan/Module-Build/lib/Module/Build/Base.pm index 5fb8506be8..706ed4f5d0 100644 --- a/cpan/Module-Build/lib/Module/Build/Base.pm +++ b/cpan/Module-Build/lib/Module/Build/Base.pm @@ -6,7 +6,7 @@ use strict; use vars qw($VERSION); use warnings; -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; BEGIN { require 5.006001 } @@ -19,7 +19,6 @@ use File::Basename (); use File::Spec 0.82 (); use File::Compare (); use Module::Build::Dumper (); -use IO::File (); use Text::ParseWords (); use Module::Build::ModuleInfo; @@ -757,17 +756,11 @@ sub ACTION_config_data { } 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 { @@ -798,10 +791,10 @@ sub ACTION_config_data { return $class; } - sub property_error { - my $self = shift; - die 'ERROR: ', @_; - } + sub property_error { + my $self = shift; + die 'ERROR: ', @_; + } sub _set_defaults { my $self = shift; @@ -831,7 +824,7 @@ sub ACTION_config_data { } } -} # end closure +} # end enclosure ######################################################################## sub _make_hash_accessor { my ($property, $p) = @_; @@ -1007,6 +1000,7 @@ __PACKAGE__->add_property($_) for qw( verbose debug xs_files + extra_manify_args ); sub config { @@ -1082,7 +1076,7 @@ sub subclass { 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; @@ -1129,83 +1123,90 @@ END_WARN 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 { @@ -1229,7 +1230,7 @@ sub _pod_parse { my $docfile = $self->_main_docfile or return; - my $fh = IO::File->new($docfile) + open(my $fh, '<', $docfile) or return; require Module::Build::PodParser; @@ -1289,13 +1290,13 @@ sub read_config { 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 { @@ -1307,13 +1308,14 @@ sub _write_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 { @@ -1511,7 +1513,7 @@ sub auto_require { 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} ) { @@ -1832,10 +1834,10 @@ use File::Spec; 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; } @@ -1972,7 +1974,7 @@ sub create_build_script { $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; @@ -2340,7 +2342,7 @@ sub read_modulebuildrc { return () unless $modulebuildrc; } - my $fh = IO::File->new( $modulebuildrc ) + open(my $fh, '<', $modulebuildrc ) or die "Can't open $modulebuildrc: $!"; my %options; my $buffer = ''; @@ -2461,7 +2463,7 @@ sub get_action_docs { (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 @@ -2759,26 +2761,28 @@ 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::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); } @@ -3104,10 +3108,10 @@ sub fix_shebang_line { # Adapted from fixin() in ExtUtils::MM_Unix 1.35 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; @@ -3124,7 +3128,7 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}' 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). @@ -3237,6 +3241,8 @@ sub ACTION_manpages { $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"}, @@ -3244,12 +3250,13 @@ sub ACTION_manpages { 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$') ] ); @@ -3262,7 +3269,7 @@ sub manify_bin_pods { 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); @@ -3276,6 +3283,7 @@ sub manify_bin_pods { 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; @@ -3287,7 +3295,7 @@ sub manify_lib_pods { 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); @@ -3321,7 +3329,7 @@ sub contains_pod { 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)/; } @@ -3368,15 +3376,18 @@ sub htmlify_pods { : $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]),'' @@ -3426,7 +3437,7 @@ sub htmlify_pods { my $depth = @rootdirs + @dirs; my %opts = ( infile => $infile, outfile => $tmpfile, - podpath => $podpath, + ( defined($podpath) ? (podpath => $podpath) : ()), podroot => $podroot, index => 1, depth => $depth, @@ -3437,8 +3448,8 @@ sub htmlify_pods { } 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) ); @@ -3446,11 +3457,11 @@ sub htmlify_pods { 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)} ) { @@ -3477,9 +3488,9 @@ sub htmlify_pods { $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! @@ -3494,9 +3505,9 @@ sub htmlify_pods { # 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); } @@ -3584,7 +3595,7 @@ sub ACTION_install { 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 { @@ -3695,10 +3706,6 @@ sub ACTION_installdeps { } } - if ( ! -x $command ) { - die "cpan_client '$command' is not executable\n"; - } - $self->do_system($command, @opts, @install); } @@ -3869,12 +3876,12 @@ sub _add_to_manifest { 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; @@ -3970,7 +3977,7 @@ HERE $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; @@ -4002,8 +4009,7 @@ EOF } 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"; @@ -4024,7 +4030,7 @@ EOF Pod::Text::pod2text( $docfile, $fh ); - $fh->close; + close $fh; } else { $self->log_warn( "Cannot create 'README' file: Can't open file for writing\n" ); @@ -4218,17 +4224,17 @@ sub _append_maniskip { 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" @@ -4254,6 +4260,8 @@ EOF $content .= '\b'.$self->dist_name.'-[\d\.\_]+'."\n"; print $fh $content; + + close $fh; return; } @@ -5417,7 +5425,7 @@ sub compile_xs { @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; } @@ -5546,7 +5554,7 @@ sub process_xs { 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 } diff --git a/cpan/Module-Build/lib/Module/Build/Compat.pm b/cpan/Module-Build/lib/Module/Build/Compat.pm index 504c6f9e1c..7f17f18213 100644 --- a/cpan/Module-Build/lib/Module/Build/Compat.pm +++ b/cpan/Module-Build/lib/Module/Build/Compat.pm @@ -2,11 +2,10 @@ package Module::Build::Compat; 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; @@ -123,7 +122,7 @@ HERE $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"; @@ -406,7 +405,7 @@ EOF 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; diff --git a/cpan/Module-Build/lib/Module/Build/Config.pm b/cpan/Module-Build/lib/Module/Build/Config.pm index 9bb5e5414d..b89732fccb 100644 --- a/cpan/Module-Build/lib/Module/Build/Config.pm +++ b/cpan/Module-Build/lib/Module/Build/Config.pm @@ -2,7 +2,7 @@ package Module::Build::Config; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Config; diff --git a/cpan/Module-Build/lib/Module/Build/ConfigData.pm b/cpan/Module-Build/lib/Module/Build/ConfigData.pm index 85fa28d869..9e49ca64bc 100644 --- a/cpan/Module-Build/lib/Module/Build/ConfigData.pm +++ b/cpan/Module-Build/lib/Module/Build/ConfigData.pm @@ -21,7 +21,6 @@ sub config_names { keys %$config } sub write { my $me = __FILE__; - require IO::File; # Can't use Module::Build::Dumper here because M::B is only a # build-time prereq of this module @@ -29,7 +28,7 @@ sub write { 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__$/; @@ -38,11 +37,11 @@ sub write { 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: $!"; @@ -188,9 +187,6 @@ do{ my $x = [ 'description' => 'Create Unix man pages' }, 'PPM_support' => { - 'requires' => { - 'IO::File' => '1.13' - }, 'description' => 'Generate PPM files for distributions' }, 'dist_authoring' => { diff --git a/cpan/Module-Build/lib/Module/Build/Cookbook.pm b/cpan/Module-Build/lib/Module/Build/Cookbook.pm index 84ef43a303..1afd6ea47e 100644 --- a/cpan/Module-Build/lib/Module/Build/Cookbook.pm +++ b/cpan/Module-Build/lib/Module/Build/Cookbook.pm @@ -1,7 +1,7 @@ package Module::Build::Cookbook; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; =head1 NAME diff --git a/cpan/Module-Build/lib/Module/Build/Dumper.pm b/cpan/Module-Build/lib/Module/Build/Dumper.pm index 7db6262201..6c4301b515 100644 --- a/cpan/Module-Build/lib/Module/Build/Dumper.pm +++ b/cpan/Module-Build/lib/Module/Build/Dumper.pm @@ -1,7 +1,7 @@ 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: diff --git a/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm b/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm index 9309fe83c1..1fc478f83f 100644 --- a/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm +++ b/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm @@ -4,7 +4,7 @@ package Module::Build::ModuleInfo; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; require Module::Metadata; diff --git a/cpan/Module-Build/lib/Module/Build/Notes.pm b/cpan/Module-Build/lib/Module/Build/Notes.pm index bd1433d9b3..adc5d1a6b0 100644 --- a/cpan/Module-Build/lib/Module/Build/Notes.pm +++ b/cpan/Module-Build/lib/Module/Build/Notes.pm @@ -4,10 +4,9 @@ package Module::Build::Notes; 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 { @@ -24,9 +23,10 @@ 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} = {}; } @@ -107,8 +107,9 @@ sub write { 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> }; @@ -127,11 +128,11 @@ sub write_config_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; @@ -188,7 +189,6 @@ sub config_names { keys %$config } sub write { my $me = __FILE__; - require IO::File; # Can't use Module::Build::Dumper here because M::B is only a # build-time prereq of this module @@ -196,7 +196,7 @@ sub write { 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__$/; @@ -205,11 +205,11 @@ sub write { 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: $!"; diff --git a/cpan/Module-Build/lib/Module/Build/PPMMaker.pm b/cpan/Module-Build/lib/Module/Build/PPMMaker.pm index a996e59345..530ff682b2 100644 --- a/cpan/Module-Build/lib/Module/Build/PPMMaker.pm +++ b/cpan/Module-Build/lib/Module/Build/PPMMaker.pm @@ -3,9 +3,8 @@ package Module::Build::PPMMaker; 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 @@ -100,12 +99,11 @@ EOF 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; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/Default.pm b/cpan/Module-Build/lib/Module/Build/Platform/Default.pm index db6a63d686..3161229dbb 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/Default.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/Default.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::Default; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm b/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm index e72ee77ccd..64711c7ad4 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/MacOS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::MacOS; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Base; use vars qw(@ISA); diff --git a/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm b/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm index 2b514e4424..27490a68d1 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/Unix.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::Unix; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm b/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm index d447fbce32..4c7a544464 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/VMS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::VMS; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Base; use Config; @@ -427,26 +427,15 @@ sub _detildefy { 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; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm b/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm index db94bf4469..72b1671b7c 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/VOS.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::VOS; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Base; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm b/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm index 859d1fbc9c..5d54318e7d 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/Windows.pm @@ -2,13 +2,12 @@ package Module::Build::Platform::Windows; 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; @@ -49,7 +48,7 @@ sub ACTION_realclean { 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 ; @@ -137,9 +136,9 @@ EOT 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++; @@ -164,13 +163,13 @@ EOT } } - 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}; } diff --git a/cpan/Module-Build/lib/Module/Build/Platform/aix.pm b/cpan/Module-Build/lib/Module/Build/Platform/aix.pm index e8928acd1c..6763c3229a 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/aix.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/aix.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::aix; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm b/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm index 136e853edb..0ff9a46e37 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/cygwin.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::cygwin; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm b/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm index 2f939a151f..c4909c1dd3 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/darwin.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::darwin; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; diff --git a/cpan/Module-Build/lib/Module/Build/Platform/os2.pm b/cpan/Module-Build/lib/Module/Build/Platform/os2.pm index 40797fb8c7..e755480031 100644 --- a/cpan/Module-Build/lib/Module/Build/Platform/os2.pm +++ b/cpan/Module-Build/lib/Module/Build/Platform/os2.pm @@ -2,7 +2,7 @@ package Module::Build::Platform::os2; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use Module::Build::Platform::Unix; diff --git a/cpan/Module-Build/lib/Module/Build/PodParser.pm b/cpan/Module-Build/lib/Module/Build/PodParser.pm index ab4f467cab..5cc4fbef02 100644 --- a/cpan/Module-Build/lib/Module/Build/PodParser.pm +++ b/cpan/Module-Build/lib/Module/Build/PodParser.pm @@ -2,7 +2,7 @@ package Module::Build::PodParser; use strict; use vars qw($VERSION); -$VERSION = '0.4005'; +$VERSION = '0.4007'; $VERSION = eval $VERSION; use vars qw(@ISA); @@ -16,7 +16,7 @@ sub new { 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; @@ -29,7 +29,7 @@ sub parse_from_filehandle { 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; diff --git a/cpan/Module-Build/lib/inc/latest.pm b/cpan/Module-Build/lib/inc/latest.pm index 631a234167..05dee95ddd 100644 --- a/cpan/Module-Build/lib/inc/latest.pm +++ b/cpan/Module-Build/lib/inc/latest.pm @@ -1,14 +1,16 @@ 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 @@ -43,7 +45,7 @@ sub write { # 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; diff --git a/cpan/Module-Build/lib/inc/latest/private.pm b/cpan/Module-Build/lib/inc/latest/private.pm index d17ecc14e5..0cb9214d96 100644 --- a/cpan/Module-Build/lib/inc/latest/private.pm +++ b/cpan/Module-Build/lib/inc/latest/private.pm @@ -1,11 +1,13 @@ 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. @@ -60,10 +62,9 @@ sub _search_bundled { 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); diff --git a/cpan/Module-Build/t/actions/installdeps.t b/cpan/Module-Build/t/actions/installdeps.t index 5df98336b5..ec90080655 100644 --- a/cpan/Module-Build/t/actions/installdeps.t +++ b/cpan/Module-Build/t/actions/installdeps.t @@ -29,18 +29,17 @@ stdout_stderr_of( sub { $mb = $dist->new_from_context('verbose' => 1) } ); 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 diff --git a/cpan/Module-Build/t/add_property_array.t b/cpan/Module-Build/t/add_property_array.t new file mode 100644 index 0000000000..3b405cb610 --- /dev/null +++ b/cpan/Module-Build/t/add_property_array.t @@ -0,0 +1,16 @@ +#!/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"; + diff --git a/cpan/Module-Build/t/add_property_hash.t b/cpan/Module-Build/t/add_property_hash.t new file mode 100644 index 0000000000..afd71f88fb --- /dev/null +++ b/cpan/Module-Build/t/add_property_hash.t @@ -0,0 +1,16 @@ +#!/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"; + diff --git a/cpan/Module-Build/t/bundle_inc.t b/cpan/Module-Build/t/bundle_inc.t index e974c26107..00dcf478ae 100644 --- a/cpan/Module-Build/t/bundle_inc.t +++ b/cpan/Module-Build/t/bundle_inc.t @@ -5,7 +5,6 @@ use lib 't/lib'; use MBTest; # or 'no_plan' use DistGen; use Config; -use IO::File; use File::Spec; use ExtUtils::Packlist; use ExtUtils::Installed; @@ -93,15 +92,14 @@ ok( -e File::Spec->catfile( $dist_inc, qw/inc_Module-Build Module Build Base.pm/ # 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 = $@; @@ -116,7 +114,7 @@ SKIP: { 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" diff --git a/cpan/Module-Build/t/compat.t b/cpan/Module-Build/t/compat.t index 1546d2b814..b6ddb938ee 100644 --- a/cpan/Module-Build/t/compat.t +++ b/cpan/Module-Build/t/compat.t @@ -4,7 +4,6 @@ use strict; 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 @@ -512,7 +511,7 @@ sub test_makefile_pl_requires_perl { } sub find_params_in_makefile { - my $fh = IO::File->new( $makefile, 'r' ) + open(my $fh, '<', $makefile ) or die "Can't read $makefile: $!"; local($/) = "\n"; diff --git a/cpan/Module-Build/t/files.t b/cpan/Module-Build/t/files.t index 625a473974..e951b800f3 100644 --- a/cpan/Module-Build/t/files.t +++ b/cpan/Module-Build/t/files.t @@ -6,7 +6,6 @@ use MBTest tests => 4; blib_load('Module::Build'); -use IO::File; my $tmp = MBTest->tmpdir; use DistGen; @@ -26,9 +25,9 @@ my $mb = Module::Build->new_from_context; 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; diff --git a/cpan/Module-Build/t/install.t b/cpan/Module-Build/t/install.t index 261411cd84..fde3958d05 100644 --- a/cpan/Module-Build/t/install.t +++ b/cpan/Module-Build/t/install.t @@ -2,7 +2,7 @@ use strict; use lib 't/lib'; -use MBTest tests => 35; +use MBTest tests => 34; blib_load('Module::Build'); @@ -36,18 +36,15 @@ $dist->regen; 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. } ); @@ -166,10 +163,6 @@ is $@, ''; '--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"; diff --git a/cpan/Module-Build/t/lib/DistGen.pm b/cpan/Module-Build/t/lib/DistGen.pm index ae8ed34390..52493724f5 100644 --- a/cpan/Module-Build/t/lib/DistGen.pm +++ b/cpan/Module-Build/t/lib/DistGen.pm @@ -15,7 +15,6 @@ use File::Basename (); use File::Find (); use File::Path (); use File::Spec (); -use IO::File (); use Tie::CPHash; use Data::Dumper; @@ -297,7 +296,7 @@ sub _gen_manifest { 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"; }; @@ -368,7 +367,7 @@ sub regen { 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}; diff --git a/cpan/Module-Build/t/lib/MBTest.pm b/cpan/Module-Build/t/lib/MBTest.pm index 0df382fc6a..c988527f88 100644 --- a/cpan/Module-Build/t/lib/MBTest.pm +++ b/cpan/Module-Build/t/lib/MBTest.pm @@ -2,7 +2,6 @@ package MBTest; use strict; -use IO::File (); use File::Spec; use File::Temp (); use File::Path (); @@ -159,7 +158,7 @@ sub stdout_stderr_of { } 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>; } diff --git a/cpan/Module-Build/t/manifypods.t b/cpan/Module-Build/t/manifypods.t index aa33ffccd0..de2a3e4fd2 100644 --- a/cpan/Module-Build/t/manifypods.t +++ b/cpan/Module-Build/t/manifypods.t @@ -68,13 +68,11 @@ my $mb = Module::Build->new( 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'), } ); diff --git a/cpan/Module-Build/t/manifypods_with_utf8.t b/cpan/Module-Build/t/manifypods_with_utf8.t new file mode 100644 index 0000000000..ebb0db64c4 --- /dev/null +++ b/cpan/Module-Build/t/manifypods_with_utf8.t @@ -0,0 +1,68 @@ +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"); + diff --git a/cpan/Module-Build/t/metadata.t b/cpan/Module-Build/t/metadata.t index d728a681e5..ce6d208645 100644 --- a/cpan/Module-Build/t/metadata.t +++ b/cpan/Module-Build/t/metadata.t @@ -2,7 +2,7 @@ use strict; use lib 't/lib'; -use MBTest tests => 52; +use MBTest tests => 14; blib_load('Module::Build'); blib_load('Module::Build::ConfigData'); @@ -16,7 +16,7 @@ my %metadata = 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 => { @@ -84,7 +84,7 @@ my $mb = Module::Build->new_from_context; 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} ), @@ -107,520 +107,3 @@ my $mb = Module::Build->new_from_context; $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, {}); - diff --git a/cpan/Module-Build/t/new_from_context.t b/cpan/Module-Build/t/new_from_context.t index f45a1760eb..a9ec00b864 100644 --- a/cpan/Module-Build/t/new_from_context.t +++ b/cpan/Module-Build/t/new_from_context.t @@ -6,7 +6,6 @@ use MBTest tests => 2; blib_load('Module::Build'); -use IO::File; my $tmp = MBTest->tmpdir; use DistGen; diff --git a/cpan/Module-Build/t/pod_parser.t b/cpan/Module-Build/t/pod_parser.t index 8c75e7d7fa..d4ebcdc91d 100644 --- a/cpan/Module-Build/t/pod_parser.t +++ b/cpan/Module-Build/t/pod_parser.t @@ -2,7 +2,7 @@ use strict; use lib 't/lib'; -use MBTest tests => 12; +use MBTest tests => 14; blib_load('Module::Build::PodParser'); @@ -113,3 +113,25 @@ EOF 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'; +} diff --git a/cpan/Module-Build/t/ppm.t b/cpan/Module-Build/t/ppm.t index 9de28ec4f3..4bc473ddf0 100644 --- a/cpan/Module-Build/t/ppm.t +++ b/cpan/Module-Build/t/ppm.t @@ -83,6 +83,7 @@ my $mb = Module::Build->new_from_context( ( installsitehtml1dir => catdir($tmp, 'site', 'html'), installsitehtml3dir => catdir($tmp, 'site', 'html') ) : () ), }, + html_links => 0, ); @@ -163,6 +164,7 @@ SKIP: { installsiteman1dir => catdir($tmp, 'site', 'man', 'man1'), installsiteman3dir => catdir($tmp, 'site', 'man', 'man3'), }, + html_links => 0, ); $mb->dispatch('ppmdist'); diff --git a/cpan/Module-Build/t/runthrough.t b/cpan/Module-Build/t/runthrough.t index 1c0edf4402..1f6730e309 100644 --- a/cpan/Module-Build/t/runthrough.t +++ b/cpan/Module-Build/t/runthrough.t @@ -125,7 +125,7 @@ ok grep {$_ eq 'save_out' } $mb->cleanup; 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; @@ -151,7 +151,7 @@ ok grep {$_ eq 'save_out' } $mb->cleanup; 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"; } diff --git a/cpan/Module-Build/t/tilde.t b/cpan/Module-Build/t/tilde.t index 04f0210f30..09673f6b92 100644 --- a/cpan/Module-Build/t/tilde.t +++ b/cpan/Module-Build/t/tilde.t @@ -100,14 +100,14 @@ SKIP: { 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 ); } diff --git a/cpan/Module-Build/t/unit_run_test_harness.t b/cpan/Module-Build/t/unit_run_test_harness.t new file mode 100644 index 0000000000..0d19be2791 --- /dev/null +++ b/cpan/Module-Build/t/unit_run_test_harness.t @@ -0,0 +1,73 @@ +#!/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]); + } + +} |