diff options
Diffstat (limited to 'gnu/usr.bin/perl/cpan/Module-Metadata')
17 files changed, 1464 insertions, 2015 deletions
diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/corpus/BOMTest/UTF16BE.pm Binary files differindex 17c6a4ad655..17c6a4ad655 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16BE.pm +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/corpus/BOMTest/UTF16BE.pm diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/corpus/BOMTest/UTF16LE.pm Binary files differindex a46de6de4e8..a46de6de4e8 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF16LE.pm +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/corpus/BOMTest/UTF16LE.pm diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/corpus/BOMTest/UTF8.pm index 9062ac60753..9062ac60753 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/BOMTest/UTF8.pm +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/corpus/BOMTest/UTF8.pm diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm index e352d316208..f7017cf90ff 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/lib/Module/Metadata.pm @@ -1,6 +1,7 @@ # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- # vim:ts=8:sw=2:et:sta:sts=2 -package Module::Metadata; +package Module::Metadata; # git description: v1.000030-2-g52f466c +# ABSTRACT: Gather package and POD information from perl module files # Adapted from Perl-licensed code originally distributed with # Module-Build by Ken Williams @@ -9,20 +10,29 @@ package Module::Metadata; # perl modules (assuming this may be expanded in the distant # parrot future to look at other types of modules). +sub __clean_eval { eval $_[0] } use strict; use warnings; -our $VERSION = '1.000019'; -$VERSION = eval $VERSION; +our $VERSION = '1.000031'; # TRIAL use Carp qw/croak/; use File::Spec; -use IO::File; +BEGIN { + # Try really hard to not depend ony any DynaLoaded module, such as IO::File or Fcntl + eval { + require Fcntl; Fcntl->import('SEEK_SET'); 1; + } or *SEEK_SET = sub { 0 } +} use version 0.87; BEGIN { if ($INC{'Log/Contextual.pm'}) { - Log::Contextual->import('log_info'); - } else { + require "Log/Contextual/WarnLogger.pm"; # Hide from AutoPrereqs + Log::Contextual->import('log_info', + '-default_logger' => Log::Contextual::WarnLogger->new({ env_prefix => 'MODULE_METADATA', }), + ); + } + else { *log_info = sub (&) { warn $_[0]->() }; } } @@ -47,14 +57,14 @@ my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name }x; my $PKG_NAME_REGEXP = qr{ # match a package name - (?: :: )? # a pkg name can start with aristotle + (?: :: )? # a pkg name can start with arisdottle $PKG_FIRST_WORD_REGEXP # a package word (?: - (?: :: )+ ### aristotle (allow one or many times) + (?: :: )+ ### arisdottle (allow one or many times) $PKG_ADDL_WORD_REGEXP ### a package word )* # ^ zero, one or many times (?: - :: # allow trailing aristotle + :: # allow trailing arisdottle )? }x; @@ -73,7 +83,7 @@ my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name ([\$*]) # sigil - $ or * ( ( # optional leading package name - (?:::|\')? # possibly starting like just :: (Ì la $::VERSION) + (?:::|\')? # possibly starting like just :: (a la $::VERSION) (?:\w+(?:::|\'))* # Foo::Bar:: ... )? VERSION @@ -87,7 +97,7 @@ my $VERS_REGEXP = qr{ # match a VERSION definition $VARNAME_REGEXP # without parens ) \s* - =[^=~] # = but not ==, nor =~ + =[^=~>] # = but not ==, nor =~, nor => }x; sub new_from_file { @@ -162,19 +172,21 @@ sub new_from_module { my $err = ''; foreach my $p ( @$packages ) { if ( defined( $p->{version} ) ) { - if ( defined( $version ) ) { - if ( $compare_versions->( $version, '!=', $p->{version} ) ) { - $err .= " $p->{file} ($p->{version})\n"; - } else { - # same version declared multiple times, ignore - } - } else { - $file = $p->{file}; - $version = $p->{version}; - } + if ( defined( $version ) ) { + if ( $compare_versions->( $version, '!=', $p->{version} ) ) { + $err .= " $p->{file} ($p->{version})\n"; + } + else { + # same version declared multiple times, ignore + } + } + else { + $file = $p->{file}; + $version = $p->{version}; + } } - $file ||= $p->{file} if defined( $p->{file} ); - } + $file ||= $p->{file} if defined( $p->{file} ); + } if ( $err ) { $err = " $file ($version)\n" . $err; @@ -234,7 +246,8 @@ sub new_from_module { if ( $files ) { @files = @$files; - } else { + } + else { find( { wanted => sub { push @files, $_ if -f $_ && /\.pm$/; @@ -264,12 +277,14 @@ sub new_from_module { if ( $package eq $prime_package ) { if ( exists( $prime{$package} ) ) { croak "Unexpected conflict in '$package'; multiple versions found.\n"; - } else { + } + else { $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename); $prime{$package}{file} = $mapped_filename; $prime{$package}{version} = $version if defined( $version ); } - } else { + } + else { push( @{$alt{$package}}, { file => $mapped_filename, version => $version, @@ -287,53 +302,57 @@ sub new_from_module { if ( exists( $prime{$package} ) ) { # primary package selected if ( $result->{err} ) { - # Use the selected primary package, but there are conflicting - # errors among multiple alternative packages that need to be - # reported + # Use the selected primary package, but there are conflicting + # errors among multiple alternative packages that need to be + # reported log_info { - "Found conflicting versions for package '$package'\n" . - " $prime{$package}{file} ($prime{$package}{version})\n" . - $result->{err} + "Found conflicting versions for package '$package'\n" . + " $prime{$package}{file} ($prime{$package}{version})\n" . + $result->{err} }; - } elsif ( defined( $result->{version} ) ) { - # There is a primary package selected, and exactly one - # alternative package - - if ( exists( $prime{$package}{version} ) && - defined( $prime{$package}{version} ) ) { - # Unless the version of the primary package agrees with the - # version of the alternative package, report a conflict - if ( $compare_versions->( + } + elsif ( defined( $result->{version} ) ) { + # There is a primary package selected, and exactly one + # alternative package + + if ( exists( $prime{$package}{version} ) && + defined( $prime{$package}{version} ) ) { + # Unless the version of the primary package agrees with the + # version of the alternative package, report a conflict + if ( $compare_versions->( $prime{$package}{version}, '!=', $result->{version} ) ) { log_info { "Found conflicting versions for package '$package'\n" . - " $prime{$package}{file} ($prime{$package}{version})\n" . - " $result->{file} ($result->{version})\n" + " $prime{$package}{file} ($prime{$package}{version})\n" . + " $result->{file} ($result->{version})\n" }; - } - - } else { - # The prime package selected has no version so, we choose to - # use any alternative package that does have a version - $prime{$package}{file} = $result->{file}; - $prime{$package}{version} = $result->{version}; - } - - } else { - # no alt package found with a version, but we have a prime - # package so we use it whether it has a version or not + } + + } + else { + # The prime package selected has no version so, we choose to + # use any alternative package that does have a version + $prime{$package}{file} = $result->{file}; + $prime{$package}{version} = $result->{version}; } - } else { # No primary package was selected, use the best alternative + } + else { + # no alt package found with a version, but we have a prime + # package so we use it whether it has a version or not + } + + } + else { # No primary package was selected, use the best alternative if ( $result->{err} ) { log_info { "Found conflicting versions for package '$package'\n" . - $result->{err} + $result->{err} }; } @@ -341,7 +360,7 @@ sub new_from_module { # something rather than nothing $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version} - if defined( $result->{version} ); + if defined( $result->{version} ); } } @@ -383,12 +402,14 @@ sub _init { my $self = bless(\%data, $class); - if ( $handle ) { - $self->_parse_fh($handle); - } - else { - $self->_parse_file(); + if ( not $handle ) { + my $filename = $self->{filename}; + open $handle, '<', $filename + or croak( "Can't open '$filename': $!" ); + + $self->_handle_bom($handle, $filename); } + $self->_parse_fh($handle); unless($self->{module} and length($self->{module})) { my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); @@ -398,17 +419,12 @@ sub _init { $self->{module} = shift(@candidates); # punt } else { - if(grep /main/, @{$self->{packages}}) { - $self->{module} = 'main'; - } - else { - $self->{module} = $self->{packages}[0] || ''; - } + $self->{module} = 'main'; } } $self->{version} = $self->{versions}{$self->{module}} - if defined( $self->{module} ); + if defined( $self->{module} ); return $self; } @@ -423,9 +439,10 @@ sub _do_find_module { foreach my $dir ( @$dirs ) { my $testfile = File::Spec->catfile($dir, $file); return [ File::Spec->rel2abs( $testfile ), $dir ] - if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp - return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ] - if -e "$testfile.pm"; + if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp + $testfile .= '.pm'; + return [ File::Spec->rel2abs( $testfile ), $dir ] + if -e $testfile; } return; } @@ -449,28 +466,16 @@ sub _parse_version_expression { my $self = shift; my $line = shift; - my( $sig, $var, $pkg ); + my( $sigil, $variable_name, $package); if ( $line =~ /$VERS_REGEXP/o ) { - ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); - if ( $pkg ) { - $pkg = ($pkg eq '::') ? 'main' : $pkg; - $pkg =~ s/::$//; + ( $sigil, $variable_name, $package) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); + if ( $package ) { + $package = ($package eq '::') ? 'main' : $package; + $package =~ s/::$//; } } - return ( $sig, $var, $pkg ); -} - -sub _parse_file { - my $self = shift; - - my $filename = $self->{filename}; - my $fh = IO::File->new( $filename ) - or croak( "Can't open '$filename': $!" ); - - $self->_handle_bom($fh, $filename); - - $self->_parse_fh($fh); + return ( $sigil, $variable_name, $package ); } # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream. @@ -478,21 +483,23 @@ sub _parse_file { sub _handle_bom { my ($self, $fh, $filename) = @_; - my $pos = $fh->getpos; + my $pos = tell $fh; return unless defined $pos; my $buf = ' ' x 2; - my $count = $fh->read( $buf, length $buf ); + my $count = read $fh, $buf, length $buf; return unless defined $count and $count >= 2; my $encoding; if ( $buf eq "\x{FE}\x{FF}" ) { $encoding = 'UTF-16BE'; - } elsif ( $buf eq "\x{FF}\x{FE}" ) { + } + elsif ( $buf eq "\x{FF}\x{FE}" ) { $encoding = 'UTF-16LE'; - } elsif ( $buf eq "\x{EF}\x{BB}" ) { + } + elsif ( $buf eq "\x{EF}\x{BB}" ) { $buf = ' '; - $count = $fh->read( $buf, length $buf ); + $count = read $fh, $buf, length $buf; if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) { $encoding = 'UTF-8'; } @@ -500,11 +507,11 @@ sub _handle_bom { if ( defined $encoding ) { if ( "$]" >= 5.008 ) { - # $fh->binmode requires perl 5.10 binmode( $fh, ":encoding($encoding)" ); } - } else { - $fh->setpos($pos) + } + else { + seek $fh, $pos, SEEK_SET or croak( sprintf "Can't reset position to the top of '$filename'" ); } @@ -515,8 +522,8 @@ sub _parse_fh { my ($self, $fh) = @_; my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 ); - my( @pkgs, %vers, %pod, @pod ); - my $pkg = 'main'; + my( @packages, %vers, %pod, @pod ); + my $package = 'main'; my $pod_sect = ''; my $pod_data = ''; my $in_end = 0; @@ -540,100 +547,104 @@ sub _parse_fh { if ( $in_pod ) { if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) { - push( @pod, $1 ); - if ( $self->{collect_pod} && length( $pod_data ) ) { + push( @pod, $1 ); + if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; $pod_data = ''; } - $pod_sect = $1; - - } elsif ( $self->{collect_pod} ) { - $pod_data .= "$line\n"; - + $pod_sect = $1; } - - } elsif ( $is_cut ) { - + elsif ( $self->{collect_pod} ) { + $pod_data .= "$line\n"; + } + next; + } + elsif ( $is_cut ) { if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; $pod_data = ''; } $pod_sect = ''; + next; + } - } else { + # Skip after __END__ + next if $in_end; - # Skip after __END__ - next if $in_end; + # Skip comments in code + next if $line =~ /^\s*#/; - # Skip comments in code - next if $line =~ /^\s*#/; + # Would be nice if we could also check $in_string or something too + if ($line eq '__END__') { + $in_end++; + next; + } - # Would be nice if we could also check $in_string or something too - if ($line eq '__END__') { - $in_end++; - next; + last if $line eq '__DATA__'; + + # parse $line to see if it's a $VERSION declaration + my( $version_sigil, $version_fullname, $version_package ) = + index($line, 'VERSION') >= 1 + ? $self->_parse_version_expression( $line ) + : (); + + if ( $line =~ /$PKG_REGEXP/o ) { + $package = $1; + my $version = $2; + push( @packages, $package ) unless grep( $package eq $_, @packages ); + $need_vers = defined $version ? 0 : 1; + + if ( not exists $vers{$package} and defined $version ){ + # Upgrade to a version object. + my $dwim_version = eval { _dwim_version($version) }; + croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n" + unless defined $dwim_version; # "0" is OK! + $vers{$package} = $dwim_version; } - last if $line eq '__DATA__'; - - # parse $line to see if it's a $VERSION declaration - my( $vers_sig, $vers_fullname, $vers_pkg ) = - ($line =~ /VERSION/) - ? $self->_parse_version_expression( $line ) - : (); - - if ( $line =~ /$PKG_REGEXP/o ) { - $pkg = $1; - push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); - $vers{$pkg} = $2 unless exists( $vers{$pkg} ); - $need_vers = defined $2 ? 0 : 1; - - # VERSION defined with full package spec, i.e. $Module::VERSION - } elsif ( $vers_fullname && $vers_pkg ) { - push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs ); - $need_vers = 0 if $vers_pkg eq $pkg; - - unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) { - $vers{$vers_pkg} = - $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); - } - - # first non-comment line in undeclared package main is VERSION - } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) { - $need_vers = 0; - my $v = - $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); - $vers{$pkg} = $v; - push( @pkgs, 'main' ); - - # first non-comment line in undeclared package defines package main - } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) { - $need_vers = 1; - $vers{main} = ''; - push( @pkgs, 'main' ); - - # only keep if this is the first $VERSION seen - } elsif ( $vers_fullname && $need_vers ) { - $need_vers = 0; - my $v = - $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); - - - unless ( defined $vers{$pkg} && length $vers{$pkg} ) { - $vers{$pkg} = $v; - } + } + # VERSION defined with full package spec, i.e. $Module::VERSION + elsif ( $version_fullname && $version_package ) { + # we do NOT save this package in found @packages + $need_vers = 0 if $version_package eq $package; + + unless ( defined $vers{$version_package} && length $vers{$version_package} ) { + $vers{$version_package} = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); } + } + # first non-comment line in undeclared package main is VERSION + elsif ( $package eq 'main' && $version_fullname && !exists($vers{main}) ) { + $need_vers = 0; + my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); + $vers{$package} = $v; + push( @packages, 'main' ); } - } + # first non-comment line in undeclared package defines package main + elsif ( $package eq 'main' && !exists($vers{main}) && $line =~ /\w/ ) { + $need_vers = 1; + $vers{main} = ''; + push( @packages, 'main' ); + } + + # only keep if this is the first $VERSION seen + elsif ( $version_fullname && $need_vers ) { + $need_vers = 0; + my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); + + unless ( defined $vers{$package} && length $vers{$package} ) { + $vers{$package} = $v; + } + } + } # end loop over each line if ( $self->{collect_pod} && length($pod_data) ) { $pod{$pod_sect} = $pod_data; } $self->{versions} = \%vers; - $self->{packages} = \@pkgs; + $self->{packages} = \@packages; $self->{pod} = \%pod; $self->{pod_headings} = \@pod; } @@ -642,50 +653,48 @@ sub _parse_fh { my $pn = 0; sub _evaluate_version_line { my $self = shift; - my( $sigil, $var, $line ) = @_; - - # Some of this code came from the ExtUtils:: hierarchy. + my( $sigil, $variable_name, $line ) = @_; - # We compile into $vsub because 'use version' would cause + # We compile into a local sub because 'use version' would cause # compiletime/runtime issues with local() - my $vsub; $pn++; # everybody gets their own package - my $eval = qq{BEGIN { my \$dummy = q# Hide from _packages_inside() - #; package Module::Metadata::_version::p$pn; + my $eval = qq{ my \$dummy = q# Hide from _packages_inside() + #; package Module::Metadata::_version::p${pn}; use version; - no strict; - no warnings; - - \$vsub = sub { - local $sigil$var; - \$$var=undef; - $line; - \$$var - }; - }}; + sub { + local $sigil$variable_name; + $line; + return \$$variable_name if defined \$$variable_name; + return \$Module::Metadata::_version::p${pn}::$variable_name; + }; + }; $eval = $1 if $eval =~ m{^(.+)}s; local $^W; # Try to get the $VERSION - eval $eval; - # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't + my $vsub = __clean_eval($eval); + # some modules say $VERSION <equal sign> $Foo::Bar::VERSION, but Foo::Bar isn't # installed, so we need to hunt in ./lib for it if ( $@ =~ /Can't locate/ && -d 'lib' ) { local @INC = ('lib',@INC); - eval $eval; + $vsub = __clean_eval($eval); } warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@; + (ref($vsub) eq 'CODE') or croak "failed to build version sub for $self->{filename}"; + my $result = eval { $vsub->() }; + # FIXME: $eval is not the right thing to print here croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@; # Upgrade it into a version object my $version = eval { _dwim_version($result) }; + # FIXME: $eval is not the right thing to print here croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" unless defined $version; # "0" is OK! @@ -765,10 +774,11 @@ sub version { my $mod = shift || $self->{module}; my $vers; if ( defined( $mod ) && length( $mod ) && - exists( $self->{versions}{$mod} ) ) { - return $self->{versions}{$mod}; - } else { - return undef; + exists( $self->{versions}{$mod} ) ) { + return $self->{versions}{$mod}; + } + else { + return undef; } } @@ -776,19 +786,42 @@ sub pod { my $self = shift; my $sect = shift; if ( defined( $sect ) && length( $sect ) && - exists( $self->{pod}{$sect} ) ) { - return $self->{pod}{$sect}; - } else { - return undef; + exists( $self->{pod}{$sect} ) ) { + return $self->{pod}{$sect}; + } + else { + return undef; } } +sub is_indexable { + my ($self, $package) = @_; + + my @indexable_packages = grep { $_ ne 'main' } $self->packages_inside; + + # check for specific package, if provided + return !! grep { $_ eq $package } @indexable_packages if $package; + + # otherwise, check for any indexable packages at all + return !! @indexable_packages; +} + 1; +__END__ + +=pod + +=encoding UTF-8 + =head1 NAME Module::Metadata - Gather package and POD information from perl module files +=head1 VERSION + +version 1.000031 + =head1 SYNOPSIS use Module::Metadata; @@ -809,13 +842,9 @@ This module provides a standard way to gather metadata about a .pm file through version of a module, the C<$VERSION> assignment is C<eval>ed, as is traditional in the CPAN toolchain. -=head1 USAGE +=head1 CLASS METHODS -=head2 Class methods - -=over 4 - -=item C<< new_from_file($filename, collect_pod => 1) >> +=head2 C<< new_from_file($filename, collect_pod => 1) >> Constructs a C<Module::Metadata> object given the path to a file. Returns undef if the filename does not exist. @@ -828,7 +857,7 @@ If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. -=item C<< new_from_handle($handle, $filename, collect_pod => 1) >> +=head2 C<< new_from_handle($handle, $filename, collect_pod => 1) >> This works just like C<new_from_file>, except that a handle can be provided as the first argument. @@ -841,7 +870,7 @@ mandatory or undef will be returned. You are responsible for setting the decoding layers on C<$handle> if required. -=item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >> +=head2 C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >> Constructs a C<Module::Metadata> object given a module or package name. Returns undef if the module cannot be found. @@ -855,7 +884,7 @@ If the file that contains the module begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. -=item C<< find_module_by_name($module, \@dirs) >> +=head2 C<< find_module_by_name($module, \@dirs) >> Returns the path to a module given the module or package name. A list of directories can be passed in as an optional parameter, otherwise @@ -863,7 +892,7 @@ of directories can be passed in as an optional parameter, otherwise Can be called as either an object or a class method. -=item C<< find_module_dir_by_name($module, \@dirs) >> +=head2 C<< find_module_dir_by_name($module, \@dirs) >> Returns the entry in C<@dirs> (or C<@INC> by default) that contains the module C<$module>. A list of directories can be passed in as an @@ -871,7 +900,7 @@ optional parameter, otherwise @INC is searched. Can be called as either an object or a class method. -=item C<< provides( %options ) >> +=head2 C<< provides( %options ) >> This is a convenience wrapper around C<package_versions_from_directory> to generate a CPAN META C<provides> data structure. It takes key/value @@ -920,7 +949,7 @@ is a hashref of the form: 'OtherPackage::Name' => ... } -=item C<< package_versions_from_directory($dir, \@files?) >> +=head2 C<< package_versions_from_directory($dir, \@files?) >> Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks for those files in C<$dir> - and reads each file for packages and versions, @@ -942,36 +971,33 @@ Note that the file path is relative to C<$dir> if that is specified. This B<must not> be used directly for CPAN META C<provides>. See the C<provides> method instead. -=item C<< log_info (internal) >> +=head2 C<< log_info (internal) >> Used internally to perform logging; imported from Log::Contextual if Log::Contextual has already been loaded, otherwise simply calls warn. -=back - -=head2 Object methods - -=over 4 +=head1 OBJECT METHODS -=item C<< name() >> +=head2 C<< name() >> Returns the name of the package represented by this module. If there -are more than one packages, it makes a best guess based on the +is more than one package, it makes a best guess based on the filename. If it's a script (i.e. not a *.pm) the package name is 'main'. -=item C<< version($package) >> +=head2 C<< version($package) >> Returns the version as defined by the $VERSION variable for the package as returned by the C<name> method if no arguments are given. If given the name of a package it will attempt to return the version of that package if it is specified in the file. -=item C<< filename() >> +=head2 C<< filename() >> Returns the absolute path to the file. +Note that this file may not actually exist on disk yet, e.g. if the module was read from an in-memory filehandle. -=item C<< packages_inside() >> +=head2 C<< packages_inside() >> Returns a list of packages. Note: this is a raw list of packages discovered (or assumed, in the case of C<main>). It is not @@ -981,19 +1007,37 @@ for example "Foo:Bar". Strange but valid package names are returned, for example "Foo::Bar::", and are left up to the caller on how to handle. -=item C<< pod_inside() >> +=head2 C<< pod_inside() >> Returns a list of POD sections. -=item C<< contains_pod() >> +=head2 C<< contains_pod() >> Returns true if there is any POD in the file. -=item C<< pod($section) >> +=head2 C<< pod($section) >> Returns the POD data in the given section. -=back +=head2 C<< is_indexable($package) >> or C<< is_indexable() >> + +Available since version 1.000020. + +Returns a boolean indicating whether the package (if provided) or any package +(otherwise) is eligible for indexing by PAUSE, the Perl Authors Upload Server. +Note This only checks for valid C<package> declarations, and does not take any +ownership information into account. + +=head1 SUPPORT + +Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Metadata> +(or L<bug-Module-Metadata@rt.cpan.org|mailto:bug-Module-Metadata@rt.cpan.org>). + +There is also a mailing list available for users of this distribution, at +L<http://lists.perl.org/list/cpan-workers.html>. + +There is also an irc channel available for users of this distribution, at +L<irc://irc.perl.org/#toolchain>. =head1 AUTHOR @@ -1003,6 +1047,102 @@ Original code from Module::Build::ModuleInfo by Ken Williams Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with assistance from David Golden (xdg) <dagolden@cpan.org>. +=head1 CONTRIBUTORS + +=for stopwords Karen Etheridge David Golden Vincent Pit Matt S Trout Chris Nehren Graham Knop Olivier Mengué Tomas Doran Tatsuhiko Miyagawa tokuhirom Peter Rabbitson Steve Hay Josh Jore Craig A. Berry Mitchell Steinbrunner Edward Zborowski Gareth Harper James Raspass Jerry D. Hedden 'BinGOs' Williams Kent Fredric + +=over 4 + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Vincent Pit <perl@profvince.com> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=item * + +Chris Nehren <apeiron@cpan.org> + +=item * + +Graham Knop <haarg@haarg.org> + +=item * + +Olivier Mengué <dolmen@cpan.org> + +=item * + +Tomas Doran <bobtfish@bobtfish.net> + +=item * + +Tatsuhiko Miyagawa <miyagawa@bulknews.net> + +=item * + +tokuhirom <tokuhirom@gmail.com> + +=item * + +Peter Rabbitson <ribasushi@cpan.org> + +=item * + +Steve Hay <steve.m.hay@googlemail.com> + +=item * + +Josh Jore <jjore@cpan.org> + +=item * + +Craig A. Berry <cberry@cpan.org> + +=item * + +David Mitchell <davem@iabyn.com> + +=item * + +David Steinbrunner <dsteinbrunner@pobox.com> + +=item * + +Edward Zborowski <ed@rubensteintech.com> + +=item * + +Gareth Harper <gareth@broadbean.com> + +=item * + +James Raspass <jraspass@gmail.com> + +=item * + +Jerry D. Hedden <jdhedden@cpan.org> + +=item * + +Chris 'BinGOs' Williams <chris@bingosnet.co.uk> + +=item * + +Kent Fredric <kentnl@cpan.org> + +=back + =head1 COPYRIGHT & LICENSE Original code Copyright (c) 2001-2011 Ken Williams. @@ -1013,4 +1153,3 @@ This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut - diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/contains_pod.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/contains_pod.t index 0b2a57da4c8..016e7844ade 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/contains_pod.t +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/contains_pod.t @@ -3,15 +3,20 @@ use warnings; use Test::More tests => 3; use Module::Metadata; -*fh_from_string = $] < 5.008 - ? require IO::Scalar && sub ($) { - IO::Scalar->new(\$_[0]); - } - : sub ($) { - open my $fh, '<', \$_[0]; - $fh - } -; +BEGIN { + *fh_from_string = $] < 5.008 + ? require IO::Scalar && sub ($) { + IO::Scalar->new(\$_[0]); + } + # hide in an eval'd string so Perl::MinimumVersion doesn't clutch its pearls + : eval <<'EVAL' + sub ($) { + open my $fh, '<', \$_[0]; + $fh + } +EVAL + ; +} { my $src = <<'...'; diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t index b010f7e727a..932614fff25 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/encoding.t @@ -22,7 +22,7 @@ plan tests => 4 * scalar(keys %versions); for my $enc (sort keys %versions) { my $pkg = "BOMTest::$enc"; my $vers = $versions{$enc}; - my $pm = File::Spec->catfile(qw<t lib BOMTest> => "$enc.pm"); + my $pm = File::Spec->catfile(qw<corpus BOMTest> => "$enc.pm"); my $info = Module::Metadata->new_from_file($pm); is( $info->name, $pkg, "$enc: default package was found" ); is( $info->version, $vers, "$enc: version for default package" ); diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/endpod.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/endpod.t index 815ec91867f..d37d8155b54 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/endpod.t +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/endpod.t @@ -1,6 +1,5 @@ use strict; use warnings; -use utf8; use Test::More tests => 2; use Module::Metadata; diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/extract-package.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/extract-package.t new file mode 100644 index 00000000000..640b23938b1 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/extract-package.t @@ -0,0 +1,146 @@ +use strict; +use warnings; +# vim:ts=8:sw=2:et:sta:sts=2 + +use Test::More 0.82; +use Module::Metadata; + +use lib 't/lib'; +use GeneratePackage; + +# parse package names +# format: { +# name => test name +# code => code snippet (string) +# package => expected package names +# } +my @pkg_names = ( +{ + name => 'package NAME', + package => [ 'Simple' ], + code => <<'---', +package Simple; +--- +}, +{ + name => 'package NAME::SUBNAME', + package => [ 'Simple::Edward' ], + code => <<'---', +package Simple::Edward; +--- +}, +{ + name => 'package NAME::SUBNAME::', + package => [ 'Simple::Edward::' ], + code => <<'---', +package Simple::Edward::; +--- +}, +{ + name => "package NAME'SUBNAME", + package => [ "Simple'Edward" ], + code => <<'---', +package Simple'Edward; +--- +}, +{ + name => "package NAME'SUBNAME::", + package => [ "Simple'Edward::" ], + code => <<'---', +package Simple'Edward::; +--- +}, +{ + name => 'package NAME::::SUBNAME', + package => [ 'Simple::::Edward' ], + code => <<'---', +package Simple::::Edward; +--- +}, +{ + name => 'package ::NAME::SUBNAME', + package => [ '::Simple::Edward' ], + code => <<'---', +package ::Simple::Edward; +--- +}, +{ + name => 'package NAME:SUBNAME (fail)', + package => [ 'main' ], + code => <<'---', +package Simple:Edward; +--- +}, +{ + name => "package NAME' (fail)", + package => [ 'main' ], + code => <<'---', +package Simple'; +--- +}, +{ + name => "package NAME::SUBNAME' (fail)", + package => [ 'main' ], + code => <<'---', +package Simple::Edward'; +--- +}, +{ + name => "package NAME''SUBNAME (fail)", + package => [ 'main' ], + code => <<'---', +package Simple''Edward; +--- +}, +{ + name => 'package NAME-SUBNAME (fail)', + package => [ 'main' ], + code => <<'---', +package Simple-Edward; +--- +}, +{ + name => 'no assumption of package merely if its $VERSION is referenced', + package => [ 'Simple' ], + code => <<'---', +package Simple; +$Foo::Bar::VERSION = '1.23'; +--- +}, +); + +my $test_num = 0; + +my $tmpdir = GeneratePackage::tmpdir(); + +foreach my $test_case (@pkg_names) { + note '-------'; + note $test_case->{name}; + my $code = $test_case->{code}; + my $expected_name = $test_case->{package}; + local $TODO = $test_case->{TODO}; + + my $warnings = ''; + local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; + + my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catdir($tmpdir, "Simple${test_num}"), 'Simple.pm', $code)); + + # whenever we drop support for 5.6, we can do this: + # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK)) + # or die "cannot open handle to code string: $!"; + # my $pm_info = Module::Metadata->new_from_handle($fh, 'lib/Simple.pm'); + + # Test::Builder will prematurely numify objects, so use this form + my $errs; + my @got = $pm_info->packages_inside(); + is_deeply( \@got, $expected_name, + "case $test_case->{name}: correct package names (expected '" . join(', ', @$expected_name) . "')" ) + or $errs++; + is( $warnings, '', "case $test_case->{name}: no warnings from parsing" ) or $errs++; + diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$code" if $errs; +} +continue { + ++$test_num; +} + +done_testing; diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/extract-version.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/extract-version.t new file mode 100644 index 00000000000..278a6029dc6 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/extract-version.t @@ -0,0 +1,691 @@ +use strict; +use warnings; +# vim:ts=8:sw=2:et:sta:sts=2 + +use Test::More 0.82; +use Data::Dumper; +use Module::Metadata; + +use lib 't/lib'; +use GeneratePackage; + +my $undef; + +# parse various module $VERSION lines +# format: { +# name => test name +# code => code snippet (string) +# vers => expected version object (in stringified form), +# } +my @modules = ( +{ + vers => $undef, + all_versions => {}, + name => 'no $VERSION line', + code => <<'---', +package Simple; +--- +}, +{ + vers => $undef, + all_versions => {}, + name => 'undefined $VERSION', + code => <<'---', +package Simple; +our $VERSION; +--- +}, +{ + vers => '1.23', + all_versions => { Simple => '1.23' }, + name => 'declared & defined on same line with "our"', + code => <<'---', +package Simple; +our $VERSION = '1.23'; +--- +}, +{ + vers => '1.23', + all_versions => { Simple => '1.23' }, + name => 'declared & defined on separate lines with "our"', + code => <<'---', +package Simple; +our $VERSION; +$VERSION = '1.23'; +--- +}, +{ + name => 'commented & defined on same line', + code => <<'---', +package Simple; +our $VERSION = '1.23'; # our $VERSION = '4.56'; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'commented & defined on separate lines', + code => <<'---', +package Simple; +# our $VERSION = '4.56'; +our $VERSION = '1.23'; +--- + vers =>'1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'use vars', + code => <<'---', +package Simple; +use vars qw( $VERSION ); +$VERSION = '1.23'; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'choose the right default package based on package/file name', + code => <<'---', +package Simple::_private; +$VERSION = '0'; +package Simple; +$VERSION = '1.23'; # this should be chosen for version +--- + vers => '1.23', + all_versions => { 'Simple' => '1.23', 'Simple::_private' => '0' }, +}, +{ + name => 'just read the first $VERSION line', + code => <<'---', +package Simple; +$VERSION = '1.23'; # we should see this line +$VERSION = eval $VERSION; # and ignore this one +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'just read the first $VERSION line in reopened package (1)', + code => <<'---', +package Simple; +$VERSION = '1.23'; +package Error::Simple; +$VERSION = '2.34'; +package Simple; +--- + vers => '1.23', + all_versions => { 'Error::Simple' => '2.34', Simple => '1.23' }, +}, +{ + name => 'just read the first $VERSION line in reopened package (2)', + code => <<'---', +package Simple; +package Error::Simple; +$VERSION = '2.34'; +package Simple; +$VERSION = '1.23'; +--- + vers => '1.23', + all_versions => { 'Error::Simple' => '2.34', Simple => '1.23' }, +}, +{ + name => 'mentions another module\'s $VERSION', + code => <<'---', +package Simple; +$VERSION = '1.23'; +if ( $Other::VERSION ) { + # whatever +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'mentions another module\'s $VERSION in a different package', + code => <<'---', +package Simple; +$VERSION = '1.23'; +package Simple2; +if ( $Simple::VERSION ) { + # whatever +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => '$VERSION checked only in assignments, not regexp ops', + code => <<'---', +package Simple; +$VERSION = '1.23'; +if ( $VERSION =~ /1\.23/ ) { + # whatever +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => '$VERSION checked only in assignments, not relational ops (1)', + code => <<'---', +package Simple; +$VERSION = '1.23'; +if ( $VERSION == 3.45 ) { + # whatever +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => '$VERSION checked only in assignments, not relational ops (2)', + code => <<'---', +package Simple; +$VERSION = '1.23'; +package Simple2; +if ( $Simple::VERSION == 3.45 ) { + # whatever +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'Fully qualified $VERSION declared in package', + code => <<'---', +package Simple; +$Simple::VERSION = 1.23; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'Differentiate fully qualified $VERSION in a package', + code => <<'---', +package Simple; +$Simple2::VERSION = '999'; +$Simple::VERSION = 1.23; +--- + vers => '1.23', + all_versions => { Simple => '1.23', Simple2 => '999' }, +}, +{ + name => 'Differentiate fully qualified $VERSION and unqualified', + code => <<'---', +package Simple; +$Simple2::VERSION = '999'; +$VERSION = 1.23; +--- + vers => '1.23', + all_versions => { Simple => '1.23', Simple2 => '999' }, +}, +{ + name => 'Differentiate fully qualified $VERSION and unqualified, other order', + code => <<'---', +package Simple; +$VERSION = 1.23; +$Simple2::VERSION = '999'; +--- + vers => '1.23', + all_versions => { Simple => '1.23', Simple2 => '999' }, +}, +{ + name => '$VERSION declared as package variable from within "main" package', + code => <<'---', +$Simple::VERSION = '1.23'; +{ + package Simple; + $x = $y, $cats = $dogs; +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => '$VERSION wrapped in parens - space inside', + code => <<'---', +package Simple; +( $VERSION ) = '1.23'; +--- + '1.23' => <<'---', # $VERSION wrapped in parens - no space inside +package Simple; +($VERSION) = '1.23'; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => '$VERSION follows a spurious "package" in a quoted construct', + code => <<'---', +package Simple; +__PACKAGE__->mk_accessors(qw( + program socket proc + package filename line codeline subroutine finished)); + +our $VERSION = "1.23"; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => '$VERSION using version.pm', + code => <<'---', + package Simple; + use version; our $VERSION = version->new('1.23'); +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => '$VERSION using version.pm and qv()', + code => <<'---', + package Simple; + use version; our $VERSION = qv('1.230'); +--- + vers => 'v1.230', + all_versions => { Simple => 'v1.230' }, +}, +{ + name => 'underscore version with an eval', + code => <<'---', + package Simple; + $VERSION = '1.23_01'; + $VERSION = eval $VERSION; +--- + vers => '1.23_01', + all_versions => { Simple => '1.23_01' }, +}, +{ + name => 'Two version assignments, no package', + code => <<'---', + $Simple::VERSION = '1.230'; + $Simple::VERSION = eval $Simple::VERSION; +--- + vers => $undef, + all_versions => { Simple => '1.230' }, +}, +{ + name => 'Two version assignments, should ignore second one', + code => <<'---', +package Simple; + $Simple::VERSION = '1.230'; + $Simple::VERSION = eval $Simple::VERSION; +--- + vers => '1.230', + all_versions => { Simple => '1.230' }, +}, +{ + name => 'declared & defined on same line with "our"', + code => <<'---', +package Simple; +our $VERSION = '1.23_00_00'; +--- + vers => '1.230000', + all_versions => { Simple => '1.230000' }, +}, +{ + name => 'package NAME VERSION', + code => <<'---', + package Simple 1.23; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'package NAME VERSION', + code => <<'---', + package Simple 1.23_01; +--- + vers => '1.23_01', + all_versions => { Simple => '1.23_01' }, +}, +{ + name => 'package NAME VERSION', + code => <<'---', + package Simple v1.2.3; +--- + vers => 'v1.2.3', + all_versions => { Simple => 'v1.2.3' }, +}, +{ + name => 'package NAME VERSION', + code => <<'---', + package Simple v1.2_3; +--- + vers => 'v1.2_3', + all_versions => { Simple => 'v1.2_3' }, +}, +{ + name => 'trailing crud', + code => <<'---', + package Simple; + our $VERSION; + $VERSION = '1.23-alpha'; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'trailing crud', + code => <<'---', + package Simple; + our $VERSION; + $VERSION = '1.23b'; +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'multi_underscore', + code => <<'---', + package Simple; + our $VERSION; + $VERSION = '1.2_3_4'; +--- + vers => '1.234', + all_versions => { Simple => '1.234' }, +}, +{ + name => 'non-numeric', + code => <<'---', + package Simple; + our $VERSION; + $VERSION = 'onetwothree'; +--- + vers => '0', + all_versions => { Simple => '0' }, +}, +{ + name => 'package NAME BLOCK, undef $VERSION', + code => <<'---', +package Simple { + our $VERSION; +} +--- + vers => $undef, + all_versions => {}, +}, +{ + name => 'package NAME BLOCK, with $VERSION', + code => <<'---', +package Simple { + our $VERSION = '1.23'; +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'package NAME VERSION BLOCK (1)', + code => <<'---', +package Simple 1.23 { + 1; +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, +}, +{ + name => 'package NAME VERSION BLOCK (2)', + code => <<'---', +package Simple v1.2.3_4 { + 1; +} +--- + vers => 'v1.2.3_4', + all_versions => { Simple => 'v1.2.3_4' }, +}, +{ + name => 'set from separately-initialised variable, two lines', + code => <<'---', +package Simple; + our $CVSVERSION = '$Revision: 1.7 $'; + our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); +} +--- + vers => '0', + all_versions => { Simple => '0' }, +}, +{ + name => 'our + bare v-string', + code => <<'---', +package Simple; +our $VERSION = v2.2.102.2; +--- + vers => 'v2.2.102.2', + all_versions => { Simple => 'v2.2.102.2' }, +}, +{ + name => 'our + dev release', + code => <<'---', +package Simple; +our $VERSION = "0.0.9_1"; +--- + vers => '0.0.9_1', + all_versions => { Simple => '0.0.9_1' }, +}, +{ + name => 'our + crazy string and substitution code', + code => <<'---', +package Simple; +our $VERSION = '1.12.B55J2qn'; our $WTF = $VERSION; $WTF =~ s/^\d+\.\d+\.//; # attempts to rationalize $WTF go here. +--- + vers => '1.12', + all_versions => { Simple => '1.12' }, +}, +{ + name => 'our in braces, as in Dist::Zilla::Plugin::PkgVersion with use_our = 1', + code => <<'---', +package Simple; +{ our $VERSION = '1.12'; } +--- + vers => '1.12', + all_versions => { Simple => '1.12' }, +}, +{ + name => 'calculated version - from Acme-Pi-3.14', + code => <<'---', +package Simple; +my $version = atan2(1,1) * 4; $Simple::VERSION = "$version"; +1; +--- + vers => sub { defined $_[0] and $_[0] =~ /^3\.14159/ }, + all_versions => sub { ref $_[0] eq 'HASH' + and keys %{$_[0]} == 1 + and (keys%{$_[0]})[0] eq 'Simple' + and (values %{$_[0]})[0] =~ /^3\.14159/ + }, +}, +{ + name => 'set from separately-initialised variable, one line', + code => <<'---', +package Simple; + my $CVSVERSION = '$Revision: 1.7 $'; our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); +} +--- + vers => '1.7', + all_versions => { Simple => '1.7' }, +}, +{ + name => 'from Lingua-StopWords-0.09/devel/gen_modules.plx', + code => <<'---', +package Foo; +our $VERSION = $Bar::VERSION; +--- + vers => $undef, + all_versions => { Foo => '0' }, +}, +{ + name => 'from XML-XSH2-2.1.17/lib/XML/XSH2/Parser.pm', + code => <<'---', +our $VERSION = # Hide from PAUSE + '1.967009'; +$VERSION = eval $VERSION; +--- + vers => $undef, + all_versions => { main => '0' }, +}, +{ + name => 'from MBARBON/Module-Info-0.30.tar.gz', + code => <<'---', +package Simple; +$VERSION = eval 'use version; 1' ? 'version'->new('0.30') : '0.30'; +--- + vers => '0.30', + all_versions => { Simple => '0.30' }, +}, +{ + name => '$VERSION inside BEGIN block', + code => <<'---', +package Simple; + BEGIN { $VERSION = '1.23' } +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, + TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135', + TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135', +}, +{ + name => 'our $VERSION inside BEGIN block', + code => <<'---', + '1.23' => <<'---', # our + BEGIN +package Simple; + BEGIN { our $VERSION = '1.23' } +} +--- + vers => '1.23', + all_versions => { Simple => '1.23' }, + TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135', + TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135', +}, +{ + name => 'no assumption of primary version merely if a package\'s $VERSION is referenced', + code => <<'---', +package Simple; +$Foo::Bar::VERSION = '1.23'; +--- + vers => undef, + all_versions => { 'Foo::Bar' => '1.23' }, +}, +{ + name => 'no package statement; bare $VERSION', + code => <<'---', +$VERSION = '1.23'; +--- + vers => undef, + all_versions => { '____caller' => '1.23' }, + TODO_all_versions => 'FIXME! RT#74741', +}, +{ + name => 'no package statement; bare $VERSION with our', + code => <<'---', +our $VERSION = '1.23'; +--- + vers => undef, + all_versions => { '____caller' => '1.23' }, + TODO_all_versions => 'FIXME! RT#74741', +}, +{ + name => 'no package statement; fully-qualified $VERSION for main', + code => <<'---', +$::VERSION = '1.23'; +--- + vers => undef, + all_versions => { 'main' => '1.23' }, +}, +{ + name => 'no package statement; fully-qualified $VERSION for other package', + code => <<'---', +$Foo::Bar::VERSION = '1.23'; +--- + vers => undef, + all_versions => { 'Foo::Bar' => '1.23' }, +}, +); + +my $test_num = 0; + +my $tmpdir = GeneratePackage::tmpdir(); + +# iterate through @modules +foreach my $test_case (@modules) { + note '-------'; + note $test_case->{name}; + my $code = $test_case->{code}; + my $expected_version = $test_case->{vers}; + + SKIP: { + skip( "No our() support until perl 5.6", (defined $expected_version ? 3 : 2) ) + if $] < 5.006 && $code =~ /\bour\b/; + skip( "No package NAME VERSION support until perl 5.11.1", (defined $expected_version ? 3 : 2) ) + if $] < 5.011001 && $code =~ /package\s+[\w\:\']+\s+v?[0-9._]+/; + + my $warnings = ''; + local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; + + my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catdir($tmpdir, "Simple${test_num}"), 'Simple.pm', $code)); + + # whenever we drop support for 5.6, we can do this: + # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK)) + # or die "cannot open handle to code string: $!"; + # my $pm_info = Module::Metadata->new_from_handle($fh, 'lib/Simple.pm'); + + my $errs; + my $got = $pm_info->version; + + # note that in Test::More 0.94 and earlier, is() stringifies first before comparing; + # from 0.95_01 and later, it just lets the objects figure out how to handle 'eq' + # We want to ensure we preserve the original, as long as it's legal, so we + # explicitly check the stringified form. + { + local $TODO = $test_case->{TODO_got_version}; + isa_ok($got, 'version') if defined $expected_version; + } + + if (ref($expected_version) eq 'CODE') { + local $TODO = $test_case->{TODO_code_sub}; + ok( + $expected_version->($got), + "case '$test_case->{name}': module version passes match sub" + ) + or $errs++; + } + else { + local $TODO = $test_case->{TODO_scalar}; + is( + (defined $got ? "$got" : $got), + $expected_version, + "case '$test_case->{name}': correct module version (" + . (defined $expected_version? "'$expected_version'" : 'undef') + . ')' + ) + or $errs++; + } + + if (exists $test_case->{all_versions}) { + local $TODO = $test_case->{TODO_all_versions}; + if (ref($expected_version) eq 'CODE') { + ok( + $test_case->{all_versions}->($pm_info->{versions}), + "case '$test_case->{name}': all extracted versions passes match sub" + ); + } + else { + is_deeply( + $pm_info->{versions}, + $test_case->{all_versions}, + 'correctly found all $VERSIONs', + ); + } + } + + is( $warnings, '', "case '$test_case->{name}': no warnings from parsing" ) or $errs++; + diag 'extracted versions: ', explain({ got => $pm_info->{versions}, module_contents => $code }) if !$ENV{PERL_CORE} && $errs; + } +} +continue { + ++$test_num; +} + +done_testing; diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/DistGen.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/DistGen.pm deleted file mode 100644 index 2353120e99d..00000000000 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/DistGen.pm +++ /dev/null @@ -1,849 +0,0 @@ -package DistGen; - -use strict; -use warnings; - -use vars qw( $VERSION $VERBOSE @EXPORT_OK); - -$VERSION = '0.01'; -$VERBOSE = 0; - -use Carp; - -use MBTest (); -use Cwd (); -use File::Basename (); -use File::Find (); -use File::Path (); -use File::Spec (); -use IO::File (); -use Tie::CPHash; -use Data::Dumper; - -my $vms_mode; -my $vms_lower_case; - -BEGIN { - $vms_mode = 0; - $vms_lower_case = 0; - if( $^O eq 'VMS' ) { - # For things like vmsify() - require VMS::Filespec; - VMS::Filespec->import; - $vms_mode = 1; - $vms_lower_case = 1; - my $vms_efs_case = 0; - my $unix_rpt = 0; - if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { - $unix_rpt = VMS::Feature::current("filename_unix_report"); - $vms_efs_case = VMS::Feature::current("efs_case_preserve"); - } else { - my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; - $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; - my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; - $vms_efs_case = $efs_case =~ /^[ET1]/i; - } - $vms_mode = 0 if $unix_rpt; - $vms_lower_case = 0 if $vms_efs_case; - } -} -BEGIN { - require Exporter; - *{import} = \&Exporter::import; - @EXPORT_OK = qw( - undent - ); -} - -sub undent { - my ($string) = @_; - - my ($space) = $string =~ m/^(\s+)/; - $string =~ s/^$space//gm; - - return($string); -} - -sub chdir_all ($) { - # OS/2 has "current directory per disk", undeletable; - # doing chdir() to another disk won't change cur-dir of initial disk... - chdir('/') if $^O eq 'os2'; - chdir shift; -} - -######################################################################## - -END { chdir_all(MBTest->original_cwd); } - -sub new { - my $self = bless {}, shift; - $self->reset(@_); -} - -sub reset { - my $self = shift; - my %options = @_; - - $options{name} ||= 'Simple'; - $options{dir} = File::Spec->rel2abs( - defined $options{dir} ? $options{dir} : MBTest->tmpdir - ); - - my %data = ( - no_manifest => 0, - xs => 0, - inc => 0, - %options, - ); - %$self = %data; - - tie %{$self->{filedata}}, 'Tie::CPHash'; - - tie %{$self->{pending}{change}}, 'Tie::CPHash'; - - # start with a fresh, empty directory - if ( -d $self->dirname ) { - warn "Warning: Removing existing directory '@{[$self->dirname]}'\n"; - File::Path::rmtree( $self->dirname ); - } - File::Path::mkpath( $self->dirname ); - - $self->_gen_default_filedata(); - - return $self; -} - -sub remove { - my $self = shift; - $self->chdir_original if($self->did_chdir); - File::Path::rmtree( $self->dirname ); - return $self; -} - -sub revert { - my ($self, $file) = @_; - if ( defined $file ) { - delete $self->{filedata}{$file}; - delete $self->{pending}{$_}{$file} for qw/change remove/; - } - else { - delete $self->{filedata}{$_} for keys %{ $self->{filedata} }; - for my $pend ( qw/change remove/ ) { - delete $self->{pending}{$pend}{$_} for keys %{ $self->{pending}{$pend} }; - } - } - $self->_gen_default_filedata; -} - -sub _gen_default_filedata { - my $self = shift; - - # TODO maybe a public method like this (but with a better name?) - my $add_unless = sub { - my $self = shift; - my ($member, $data) = @_; - $self->add_file($member, $data) unless($self->{filedata}{$member}); - }; - - if ( ! $self->{inc} ) { - $self->$add_unless('Build.PL', undent(<<" ---")); - use strict; - use Module::Build; - - my \$builder = Module::Build->new( - module_name => '$self->{name}', - license => 'perl', - ); - - \$builder->create_build_script(); - --- - } - else { - $self->$add_unless('Build.PL', undent(<<" ---")); - use strict; - use inc::latest 'Module::Build'; - - my \$builder = Module::Build->new( - module_name => '$self->{name}', - license => 'perl', - ); - - \$builder->create_build_script(); - --- - } - - my $module_filename = - join( '/', ('lib', split(/::/, $self->{name})) ) . '.pm'; - - unless ( $self->{xs} ) { - $self->$add_unless($module_filename, undent(<<" ---")); - package $self->{name}; - - use vars qw( \$VERSION ); - \$VERSION = '0.01'; - - use strict; - use warnings; - - 1; - - __END__ - - =head1 NAME - - $self->{name} - Perl extension for blah blah blah - - =head1 DESCRIPTION - - Stub documentation for $self->{name}. - - =head1 AUTHOR - - A. U. Thor, a.u.thor\@a.galaxy.far.far.away - - =cut - --- - - $self->$add_unless('t/basic.t', undent(<<" ---")); - use Test::More tests => 1; - use strict; - use warnings; - - use $self->{name}; - ok 1; - --- - - } else { - $self->$add_unless($module_filename, undent(<<" ---")); - package $self->{name}; - - \$VERSION = '0.01'; - - require Exporter; - require DynaLoader; - - \@ISA = qw(Exporter DynaLoader); - \@EXPORT_OK = qw( okay ); - - bootstrap $self->{name} \$VERSION; - - 1; - - __END__ - - =head1 NAME - - $self->{name} - Perl extension for blah blah blah - - =head1 DESCRIPTION - - Stub documentation for $self->{name}. - - =head1 AUTHOR - - A. U. Thor, a.u.thor\@a.galaxy.far.far.away - - =cut - --- - - my $xs_filename = - join( '/', ('lib', split(/::/, $self->{name})) ) . '.xs'; - $self->$add_unless($xs_filename, undent(<<" ---")); - #include "EXTERN.h" - #include "perl.h" - #include "XSUB.h" - - MODULE = $self->{name} PACKAGE = $self->{name} - - SV * - okay() - CODE: - RETVAL = newSVpv( "ok", 0 ); - OUTPUT: - RETVAL - - const char * - xs_version() - CODE: - RETVAL = XS_VERSION; - OUTPUT: - RETVAL - - const char * - version() - CODE: - RETVAL = VERSION; - OUTPUT: - RETVAL - --- - - # 5.6 is missing const char * in its typemap - $self->$add_unless('typemap', undent(<<" ---")); - const char *\tT_PV - --- - - $self->$add_unless('t/basic.t', undent(<<" ---")); - use Test::More tests => 2; - use strict; - - use $self->{name}; - ok 1; - - ok( $self->{name}::okay() eq 'ok' ); - --- - } -} - -sub _gen_manifest { - my $self = shift; - my $manifest = shift; - - my $fh = IO::File->new( ">$manifest" ) or do { - die "Can't write '$manifest'\n"; - }; - - my @files = ( 'MANIFEST', keys %{$self->{filedata}} ); - my $data = join( "\n", sort @files ) . "\n"; - print $fh $data; - close( $fh ); - - $self->{filedata}{MANIFEST} = $data; - $self->{pending}{change}{MANIFEST} = 1; -} - -sub name { shift()->{name} } - -sub dirname { - my $self = shift; - my $dist = $self->{distdir} || join( '-', split( /::/, $self->{name} ) ); - return File::Spec->catdir( $self->{dir}, $dist ); -} - -sub _real_filename { - my $self = shift; - my $filename = shift; - return File::Spec->catfile( split( /\//, $filename ) ); -} - -sub regen { - my $self = shift; - my %opts = @_; - - my $dist_dirname = $self->dirname; - - if ( $opts{clean} ) { - $self->clean() if -d $dist_dirname; - } else { - # TODO: This might leave dangling directories; e.g. if the removed file - # is 'lib/Simple/Simon.pm', the directory 'lib/Simple' will be left - # even if there are no files left in it. However, clean() will remove it. - my @files = keys %{$self->{pending}{remove}}; - foreach my $file ( @files ) { - my $real_filename = $self->_real_filename( $file ); - my $fullname = File::Spec->catfile( $dist_dirname, $real_filename ); - if ( -e $fullname ) { - 1 while unlink( $fullname ); - } - print "Unlinking pending file '$file'\n" if $VERBOSE; - delete( $self->{pending}{remove}{$file} ); - } - } - - foreach my $file ( keys( %{$self->{filedata}} ) ) { - my $real_filename = $self->_real_filename( $file ); - my $fullname = File::Spec->catfile( $dist_dirname, $real_filename ); - - if ( ! -e $fullname || - ( -e $fullname && $self->{pending}{change}{$file} ) ) { - - print "Changed file '$file'.\n" if $VERBOSE; - - my $dirname = File::Basename::dirname( $fullname ); - unless ( -d $dirname ) { - File::Path::mkpath( $dirname ) or do { - die "Can't create '$dirname'\n"; - }; - } - - if ( -e $fullname ) { - 1 while unlink( $fullname ); - } - - my $fh = IO::File->new(">$fullname") or do { - die "Can't write '$fullname'\n"; - }; - print $fh $self->{filedata}{$file}; - close( $fh ); - } - - delete( $self->{pending}{change}{$file} ); - } - - my $manifest = File::Spec->catfile( $dist_dirname, 'MANIFEST' ); - unless ( $self->{no_manifest} ) { - if ( -e $manifest ) { - 1 while unlink( $manifest ); - } - $self->_gen_manifest( $manifest ); - } - return $self; -} - -sub clean { - my $self = shift; - - my $here = Cwd::abs_path(); - my $there = File::Spec->rel2abs( $self->dirname() ); - - if ( -d $there ) { - chdir( $there ) or die "Can't change directory to '$there'\n"; - } else { - die "Distribution not found in '$there'\n"; - } - - my %names; - tie %names, 'Tie::CPHash'; - foreach my $file ( keys %{$self->{filedata}} ) { - my $filename = $self->_real_filename( $file ); - $filename = lc($filename) if $vms_lower_case; - my $dirname = File::Basename::dirname( $filename ); - - $names{$filename} = 0; - - print "Splitting '$dirname'\n" if $VERBOSE; - my @dirs = File::Spec->splitdir( $dirname ); - while ( @dirs ) { - my $dir = ( scalar(@dirs) == 1 - ? $dirname - : File::Spec->catdir( @dirs ) ); - if (length $dir) { - print "Setting directory name '$dir' in \%names\n" if $VERBOSE; - $names{$dir} = 0; - } - pop( @dirs ); - } - } - - File::Find::finddepth( sub { - my $name = File::Spec->canonpath( $File::Find::name ); - - if ($vms_mode) { - if ($name ne '.') { - $name =~ s/\.\z//; - $name = vmspath($name) if -d $name; - } - } - if ($^O eq 'VMS') { - $name = File::Spec->rel2abs($name) if $name eq File::Spec->curdir(); - } - - if ( not exists $names{$name} ) { - print "Removing '$name'\n" if $VERBOSE; - File::Path::rmtree( $_ ); - } - }, ($^O eq 'VMS' ? './' : File::Spec->curdir) ); - - chdir_all( $here ); - return $self; -} - -sub add_file { - my $self = shift; - $self->change_file( @_ ); -} - -sub remove_file { - my $self = shift; - my $file = shift; - unless ( exists $self->{filedata}{$file} ) { - warn "Can't remove '$file': It does not exist.\n" if $VERBOSE; - } - delete( $self->{filedata}{$file} ); - $self->{pending}{remove}{$file} = 1; - return $self; -} - -sub change_build_pl { - my ($self, @opts) = @_; - - my $opts = ref $opts[0] eq 'HASH' ? $opts[0] : { @opts }; - - local $Data::Dumper::Terse = 1; - (my $args = Dumper($opts)) =~ s/^\s*\{|\}\s*$//g; - - $self->change_file( 'Build.PL', undent(<<" ---") ); - use strict; - use warnings; - use Module::Build; - my \$b = Module::Build->new( - # Some CPANPLUS::Dist::Build versions need to allow mismatches - # On logic: thanks to Module::Install, CPAN.pm must set both keys, but - # CPANPLUS sets only the one - allow_mb_mismatch => ( - \$ENV{PERL5_CPANPLUS_IS_RUNNING} && ! \$ENV{PERL5_CPAN_IS_RUNNING} ? 1 : 0 - ), - $args - ); - \$b->create_build_script(); - --- - return $self; -} - -sub change_file { - my $self = shift; - my $file = shift; - my $data = shift; - $self->{filedata}{$file} = $data; - $self->{pending}{change}{$file} = 1; - return $self; -} - -sub get_file { - my $self = shift; - my $file = shift; - exists($self->{filedata}{$file}) or croak("no such entry: '$file'"); - return $self->{filedata}{$file}; -} - -sub chdir_in { - my $self = shift; - $self->{original_dir} ||= Cwd::cwd; # only once! - my $dir = $self->dirname; - chdir($dir) or die "Can't chdir to '$dir': $!"; - return $self; -} -######################################################################## - -sub did_chdir { exists shift()->{original_dir} } - -######################################################################## - -sub chdir_original { - my $self = shift; - - my $dir = delete $self->{original_dir}; - chdir_all($dir) or die "Can't chdir to '$dir': $!"; - return $self; -} -######################################################################## - -sub new_from_context { - my ($self, @args) = @_; - require Module::Build; - return Module::Build->new_from_context( quiet => 1, @args ); -} - -sub run_build_pl { - my ($self, @args) = @_; - require Module::Build; - return Module::Build->run_perl_script('Build.PL', [], [@args]) -} - -sub run_build { - my ($self, @args) = @_; - require Module::Build; - my $build_script = $^O eq 'VMS' ? 'Build.com' : 'Build'; - return Module::Build->run_perl_script($build_script, [], [@args]) -} - -1; - -__END__ - - -=head1 NAME - -DistGen - Creates simple distributions for testing. - -=head1 SYNOPSIS - - use DistGen; - - # create distribution and prepare to test - my $dist = DistGen->new(name => 'Foo::Bar'); - $dist->chdir_in; - - # change distribution files - $dist->add_file('t/some_test.t', $contents); - $dist->change_file('MANIFEST.SKIP', $new_contents); - $dist->remove_file('t/some_test.t'); - $dist->regen; - - # undo changes and clean up extraneous files - $dist->revert; - $dist->clean; - - # exercise the command-line interface - $dist->run_build_pl(); - $dist->run_build('test'); - - # start over as a new distribution - $dist->reset( name => 'Foo::Bar', xs => 1 ); - $dist->chdir_in; - -=head1 USAGE - -A DistGen object manages a set of files in a distribution directory. - -The C<new()> constructor initializes the object and creates an empty -directory for the distribution. It does not create files or chdir into -the directory. The C<reset()> method re-initializes the object in a -new directory with new parameters. It also does not create files or change -the current directory. - -Some methods only define the target state of the distribution. They do B<not> -make any changes to the filesystem: - - add_file - change_file - change_build_pl - remove_file - revert - -Other methods then change the filesystem to match the target state of -the distribution: - - clean - regen - remove - -Other methods are provided for a convenience during testing. The -most important is the one to enter the distribution directory: - - chdir_in - -Additional methods portably encapsulate running Build.PL and Build: - - run_build_pl - run_build - -=head1 API - -=head2 Constructors - -=head3 new() - -Create a new object and an empty directory to hold the distribution's files. -If no C<dir> option is provided, it defaults to MBTest->tmpdir, which sets -a different temp directory for Perl core testing and CPAN testing. - -The C<new> method does not write any files -- see L</regen()> below. - - my $dist = DistGen->new( - name => 'Foo::Bar', - dir => MBTest->tmpdir, - xs => 1, - no_manifest => 0, - ); - -The parameters are as follows. - -=over - -=item name - -The name of the module this distribution represents. The default is -'Simple'. This should be a "Foo::Bar" (module) name, not a "Foo-Bar" -dist name. - -=item dir - -The (parent) directory in which to create the distribution directory. The -distribution will be created under this according to C<distdir> parameter -below. Defaults to a temporary directory. - - $dist = DistGen->new( dir => '/tmp/MB-test' ); - $dist->regen; - - # distribution files have been created in /tmp/MB-test/Simple - -=item distdir - -The name of the distribution directory to create. Defaults to the dist form of -C<name>, e.g. 'Foo-Bar' if C<name> is 'Foo::Bar'. - -=item xs - -If true, generates an XS based module. - -=item no_manifest - -If true, C<regen()> will not create a MANIFEST file. - -=back - -The following files are added as part of the default distribution: - - Build.PL - lib/Simple.pm # based on name parameter - t/basic.t - -If an XS module is generated, Simple.pm and basic.t are different and -the following files are also added: - - typemap - lib/Simple.xs # based on name parameter - -=head3 reset() - -The C<reset> method re-initializes the object as if it were generated -from a fresh call to C<new>. It takes the same optional parameters as C<new>. - - $dist->reset( name => 'Foo::Bar', xs => 0 ); - -=head2 Adding and editing files - -Note that C<$filename> should always be specified with unix-style paths, -and are relative to the distribution root directory, e.g. C<lib/Module.pm>. - -No changes are made to the filesystem until the distribution is regenerated. - -=head3 add_file() - -Add a $filename containing $content to the distribution. - - $dist->add_file( $filename, $content ); - -=head3 change_file() - -Changes the contents of $filename to $content. No action is performed -until the distribution is regenerated. - - $dist->change_file( $filename, $content ); - -=head3 change_build_pl() - -A wrapper around change_file specifically for setting Build.PL. Instead -of file C<$content>, it takes a hash-ref of Module::Build constructor -arguments: - - $dist->change_build_pl( - { - module_name => $dist->name, - dist_version => '3.14159265', - license => 'perl', - create_readme => 1, - } - ); - -=head3 get_file - -Retrieves the target contents of C<$filename>. - - $content = $dist->get_file( $filename ); - -=head3 remove_file() - -Removes C<$filename> from the distribution. - - $dist->remove_file( $filename ); - -=head3 revert() - -Returns the object to its initial state, or given a $filename it returns that -file to its initial state if it is one of the built-in files. - - $dist->revert; - $dist->revert($filename); - -=head2 Changing the distribution directory - -These methods immediately affect the filesystem. - -=head3 regen() - -Regenerate all missing or changed files. Also deletes any files -flagged for removal with remove_file(). - - $dist->regen(clean => 1); - -If the optional C<clean> argument is given, it also calls C<clean>. These -can also be chained like this, instead: - - $dist->clean->regen; - -=head3 clean() - -Removes any files that are not part of the distribution. - - $dist->clean; - -=head3 remove() - -Changes back to the original directory and removes the distribution -directory (but not the temporary directory set during C<new()>). - - $dist = DistGen->new->chdir->regen; - # ... do some testing ... - - $dist->remove->chdir_in->regen; - # ... do more testing ... - -This is like a more aggressive form of C<clean>. Generally, calling C<clean> -and C<regen> should be sufficient. - -=head2 Changing directories - -=head3 chdir_in - -Change directory into the dist root. - - $dist->chdir_in; - -=head3 chdir_original - -Returns to whatever directory you were in before chdir_in() (regardless -of the cwd.) - - $dist->chdir_original; - -=head2 Command-line helpers - -These use Module::Build->run_perl_script() to ensure that Build.PL or Build are -run in a separate process using the current perl interpreter. (Module::Build -is loaded on demand). They also ensure appropriate naming for operating -systems that require a suffix for Build. - -=head3 run_build_pl - -Runs Build.PL using the current perl interpreter. Any arguments are -passed on the command line. - - $dist->run_build_pl('--quiet'); - -=head3 run_build - -Runs Build using the current perl interpreter. Any arguments are -passed on the command line. - - $dist->run_build(qw/test --verbose/); - -=head2 Properties - -=head3 name() - -Returns the name of the distribution. - - $dist->name: # e.g. Foo::Bar - -=head3 dirname() - -Returns the directory where the distribution is created. - - $dist->dirname; # e.g. t/_tmp/Simple - -=head2 Functions - -=head3 undent() - -Removes leading whitespace from a multi-line string according to the -amount of whitespace on the first line. - - my $string = undent(" foo(\n bar => 'baz'\n )"); - $string eq "foo( - bar => 'baz' - )"; - -=cut - -# vim:ts=2:sw=2:et:sta diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/ENDPOD.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/ENDPOD.pm index cb603948475..e43e07bde58 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/ENDPOD.pm +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/ENDPOD.pm @@ -1,7 +1,6 @@ package ENDPOD; use strict; use warnings; -use utf8; 1; diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/GeneratePackage.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/GeneratePackage.pm new file mode 100644 index 00000000000..07c92d37133 --- /dev/null +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/GeneratePackage.pm @@ -0,0 +1,38 @@ +use strict; +use warnings; +package GeneratePackage; +# vim:ts=8:sw=2:et:sta:sts=2 + +use base 'Exporter'; +our @EXPORT = qw(tmpdir generate_file); + +use Cwd; +use File::Spec; +use File::Path; +use File::Temp; +use IO::File; + +sub tmpdir { + File::Temp::tempdir( + 'MMD-XXXXXXXX', + CLEANUP => 1, + DIR => ($ENV{PERL_CORE} ? File::Spec->rel2abs(Cwd::cwd) : File::Spec->tmpdir), + ); +} + +sub generate_file { + my ($dir, $rel_filename, $content) = @_; + + File::Path::mkpath($dir) or die "failed to create '$dir'"; + my $abs_filename = File::Spec->catfile($dir, $rel_filename); + + Test::More::note("working on $abs_filename"); + + my $fh = IO::File->new(">$abs_filename") or die "Can't write '$abs_filename'\n"; + print $fh $content; + close $fh; + + return $abs_filename; +} + +1; diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/MBTest.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/MBTest.pm deleted file mode 100644 index fb239abf480..00000000000 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/MBTest.pm +++ /dev/null @@ -1,280 +0,0 @@ -package MBTest; - -use strict; -use warnings; - -use IO::File (); -use File::Spec; -use File::Temp (); -use File::Path (); - - -# Setup the code to clean out %ENV -BEGIN { - # Environment variables which might effect our testing - my @delete_env_keys = qw( - HOME - DEVEL_COVER_OPTIONS - MODULEBUILDRC - PERL_MB_OPT - HARNESS_TIMER - HARNESS_OPTIONS - HARNESS_VERBOSE - PREFIX - INSTALL_BASE - INSTALLDIRS - ); - - # Remember the ENV values because on VMS %ENV is global - # to the user, not the process. - my %restore_env_keys; - - sub clean_env { - for my $key (@delete_env_keys) { - if( exists $ENV{$key} ) { - $restore_env_keys{$key} = delete $ENV{$key}; - } - else { - delete $ENV{$key}; - } - } - } - - END { - while( my($key, $val) = each %restore_env_keys ) { - $ENV{$key} = $val; - } - } -} - - -BEGIN { - clean_env(); - - # In case the test wants to use our other bundled - # modules, make sure they can be loaded. - my $t_lib = File::Spec->catdir('t', 'bundled'); - push @INC, $t_lib; # Let user's installed version override - - if ($ENV{PERL_CORE}) { - # We change directories, so expand @INC and $^X to absolute paths - # Also add . - @INC = (map(File::Spec->rel2abs($_), @INC), "."); - $^X = File::Spec->rel2abs($^X); - } -} - -use Exporter; -use Test::More; -use Config; -use Cwd (); - -# We pass everything through to Test::More -use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); -$VERSION = 0.01_01; -@ISA = qw(Test::More); # Test::More isa Exporter -@EXPORT = @Test::More::EXPORT; -%EXPORT_TAGS = %Test::More::EXPORT_TAGS; - -# We have a few extra exports, but Test::More has a special import() -# that won't take extra additions. -my @extra_exports = qw( - stdout_of - stderr_of - stdout_stderr_of - slurp - find_in_path - check_compiler - have_module - blib_load - timed_out -); -push @EXPORT, @extra_exports; -__PACKAGE__->export(scalar caller, @extra_exports); -# XXX ^-- that should really happen in import() - - -######################################################################## - -# always return to the current directory -{ - my $cwd = File::Spec->rel2abs(Cwd::cwd); - - sub original_cwd { return $cwd } - - END { - # Go back to where you came from! - chdir $cwd or die "Couldn't chdir to $cwd"; - } -} -######################################################################## - -{ # backwards compatible temp filename recipe adapted from perlfaq - my $tmp_count = 0; - my $tmp_base_name = sprintf("MB-%d-%d", $$, time()); - sub temp_file_name { - sprintf("%s-%04d", $tmp_base_name, ++$tmp_count) - } -} -######################################################################## - -# Setup a temp directory -sub tmpdir { - my ($self, @args) = @_; - my $dir = $ENV{PERL_CORE} ? MBTest->original_cwd : File::Spec->tmpdir; - return File::Temp::tempdir('MB-XXXXXXXX', CLEANUP => 1, DIR => $dir, @args); -} - -BEGIN { - $ENV{HOME} = tmpdir; # don't want .modulebuildrc or other things interfering -} - -sub save_handle { - my ($handle, $subr) = @_; - my $outfile = File::Spec->catfile(File::Spec->tmpdir, temp_file_name()); - - local *SAVEOUT; - open SAVEOUT, ">&" . fileno($handle) - or die "Can't save output handle: $!"; - open $handle, "> $outfile" or die "Can't create $outfile: $!"; - - eval {$subr->()}; - open $handle, ">&SAVEOUT" or die "Can't restore output: $!"; - - my $ret = slurp($outfile); - 1 while unlink $outfile; - return $ret; -} - -sub stdout_of { save_handle(\*STDOUT, @_) } -sub stderr_of { save_handle(\*STDERR, @_) } -sub stdout_stderr_of { - my $subr = shift; - my ($stdout, $stderr); - $stdout = stdout_of ( sub { - $stderr = stderr_of( $subr ) - }); - return wantarray ? ($stdout, $stderr) : $stdout . $stderr; -} - -sub slurp { - my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!"; - local $/; - return scalar <$fh>; -} - -# Some extensions we should know about if we're looking for executables -sub exe_exts { - - if ($^O eq 'MSWin32') { - return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat'); - } - if ($^O eq 'os2') { - return qw(.exe .com .pl .cmd .bat .sh .ksh); - } - return; -} - -sub find_in_path { - my $thing = shift; - - my @exe_ext = exe_exts(); - if ( File::Spec->file_name_is_absolute( $thing ) ) { - foreach my $ext ( '', @exe_ext ) { - return "$thing$ext" if -e "$thing$ext"; - } - } - else { - my @path = split $Config{path_sep}, $ENV{PATH}; - foreach (@path) { - my $fullpath = File::Spec->catfile($_, $thing); - foreach my $ext ( '', @exe_ext ) { - return "$fullpath$ext" if -e "$fullpath$ext"; - } - } - } - return; -} - -sub check_compiler { - return (1,1) if $ENV{PERL_CORE}; - - local $SIG{__WARN__} = sub {}; - - blib_load('Module::Build'); - my $mb = Module::Build->current; - $mb->verbose( 0 ); - - my $have_c_compiler; - stderr_of( sub {$have_c_compiler = $mb->have_c_compiler} ); - - # check noexec tmpdir - my $tmp_exec; - if ( $have_c_compiler ) { - my $dir = MBTest->tmpdir; - my $c_file = File::Spec->catfile($dir,'test.c'); - open my $fh, ">", $c_file; - print {$fh} "int main() { return 0; }\n"; - close $fh; - my $exe = $mb->cbuilder->link_executable( - objects => $mb->cbuilder->compile( source => $c_file ) - ); - $tmp_exec = 0 == system( $exe ); - } - return ($have_c_compiler, $tmp_exec); -} - -sub have_module { - my $module = shift; - return eval "require $module; 1"; -} - -sub blib_load { - # Load the given module and ensure it came from blib/, not the larger system - my $mod = shift; - have_module($mod) or die "Error loading $mod\: $@\n"; - - (my $path = $mod) =~ s{::}{/}g; - $path .= ".pm"; - my ($pkg, $file, $line) = caller; - unless($ENV{PERL_CORE}) { - unless($INC{$path} =~ m/\bblib\b/) { - (my $load_from = $INC{$path}) =~ s{$path$}{}; - die "$mod loaded from '$load_from'\nIt should have been loaded from blib. \@INC contains:\n ", - join("\n ", @INC) . "\nFatal error occured in blib_load() at $file, line $line.\n"; - } - } -} - -sub timed_out { - my ($sub, $timeout) = @_; - return unless $sub; - $timeout ||= 60; - - my $saw_alarm = 0; - eval { - local $SIG{ALRM} = sub { $saw_alarm++; die "alarm\n"; }; # NB: \n required - alarm $timeout; - $sub->(); - alarm 0; - }; - if ($@) { - die unless $@ eq "alarm\n"; # propagate unexpected errors - } - return $saw_alarm; -} - -sub check_EUI { - my $timed_out; - stdout_stderr_of( sub { - $timed_out = timed_out( sub { - ExtUtils::Installed->new(extra_libs => [@INC]) - } - ); - } - ); - return ! $timed_out; -} - -1; -# vim:ts=2:sw=2:et:sta diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/Tie/CPHash.pm b/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/Tie/CPHash.pm deleted file mode 100644 index 217d6425767..00000000000 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/lib/Tie/CPHash.pm +++ /dev/null @@ -1,195 +0,0 @@ -#--------------------------------------------------------------------- -package Tie::CPHash; -# -# Copyright 1997 Christopher J. Madsen -# -# Author: Christopher J. Madsen <cjm@pobox.com> -# Created: 08 Nov 1997 -# $Revision$ $Date$ -# -# This program is free software; you can redistribute it and/or modify -# it under the same terms as Perl itself. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the -# GNU General Public License or the Artistic License for more details. -# -# Case preserving but case insensitive hash -#--------------------------------------------------------------------- - -require 5.000; -use strict; -use warnings; -use vars qw(@ISA $VERSION); - -@ISA = qw(); - -#===================================================================== -# Package Global Variables: - -$VERSION = '1.02'; - -#===================================================================== -# Tied Methods: -#--------------------------------------------------------------------- -# TIEHASH classname -# The method invoked by the command `tie %hash, classname'. -# Associates a new hash instance with the specified class. - -sub TIEHASH -{ - bless {}, $_[0]; -} # end TIEHASH - -#--------------------------------------------------------------------- -# STORE this, key, value -# Store datum *value* into *key* for the tied hash *this*. - -sub STORE -{ - $_[0]->{lc $_[1]} = [ $_[1], $_[2] ]; -} # end STORE - -#--------------------------------------------------------------------- -# FETCH this, key -# Retrieve the datum in *key* for the tied hash *this*. - -sub FETCH -{ - my $v = $_[0]->{lc $_[1]}; - ($v ? $v->[1] : undef); -} # end FETCH - -#--------------------------------------------------------------------- -# FIRSTKEY this -# Return the (key, value) pair for the first key in the hash. - -sub FIRSTKEY -{ - my $a = scalar keys %{$_[0]}; - &NEXTKEY; -} # end FIRSTKEY - -#--------------------------------------------------------------------- -# NEXTKEY this, lastkey -# Return the next (key, value) pair for the hash. - -sub NEXTKEY -{ - my $v = (each %{$_[0]})[1]; - ($v ? $v->[0] : undef ); -} # end NEXTKEY - -#--------------------------------------------------------------------- -# SCALAR this -# Return bucket usage information for the hash (0 if empty). - -sub SCALAR -{ - scalar %{$_[0]}; -} # end SCALAR - -#--------------------------------------------------------------------- -# EXISTS this, key -# Verify that *key* exists with the tied hash *this*. - -sub EXISTS -{ - exists $_[0]->{lc $_[1]}; -} # end EXISTS - -#--------------------------------------------------------------------- -# DELETE this, key -# Delete the key *key* from the tied hash *this*. -# Returns the old value, or undef if it didn't exist. - -sub DELETE -{ - my $v = delete $_[0]->{lc $_[1]}; - ($v ? $v->[1] : undef); -} # end DELETE - -#--------------------------------------------------------------------- -# CLEAR this -# Clear all values from the tied hash *this*. - -sub CLEAR -{ - %{$_[0]} = (); -} # end CLEAR - -#===================================================================== -# Other Methods: -#--------------------------------------------------------------------- -# Return the case of KEY. - -sub key -{ - my $v = $_[0]->{lc $_[1]}; - ($v ? $v->[0] : undef); -} - -#===================================================================== -# Package Return Value: - -1; - -__END__ - -=head1 NAME - -Tie::CPHash - Case preserving but case insensitive hash table - -=head1 SYNOPSIS - - require Tie::CPHash; - tie %cphash, 'Tie::CPHash'; - - $cphash{'Hello World'} = 'Hi there!'; - printf("The key `%s' was used to store `%s'.\n", - tied(%cphash)->key('HELLO WORLD'), - $cphash{'HELLO world'}); - -=head1 DESCRIPTION - -The B<Tie::CPHash> module provides a hash table that is case -preserving but case insensitive. This means that - - $cphash{KEY} $cphash{key} - $cphash{Key} $cphash{keY} - -all refer to the same entry. Also, the hash remembers which form of -the key was last used to store the entry. The C<keys> and C<each> -functions will return the key that was used to set the value. - -An example should make this clear: - - tie %h, 'Tie::CPHash'; - $h{Hello} = 'World'; - print $h{HELLO}; # Prints 'World' - print keys(%h); # Prints 'Hello' - $h{HELLO} = 'WORLD'; - print $h{hello}; # Prints 'WORLD' - print keys(%h); # Prints 'HELLO' - -The additional C<key> method lets you fetch the case of a specific key: - - # When run after the previous example, this prints 'HELLO': - print tied(%h)->key('Hello'); - -(The C<tied> function returns the object that C<%h> is tied to.) - -If you need a case insensitive hash, but don't need to preserve case, -just use C<$hash{lc $key}> instead of C<$hash{$key}>. This has a lot -less overhead than B<Tie::CPHash>. - -=head1 AUTHOR - -Christopher J. Madsen E<lt>F<cjm@pobox.com>E<gt> - -=cut - -# Local Variables: -# tmtrack-file-task: "Tie::CPHash.pm" -# End: diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t index 2c2eb9ef6d7..068a8657b15 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/metadata.t @@ -1,375 +1,130 @@ -#!/usr/bin/perl -w # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- # vim:ts=8:sw=2:et:sta:sts=2 use strict; use warnings; -use lib 't/lib'; +use Test::More 0.82; use IO::File; -use MBTest; +use File::Spec; +use File::Temp; +use File::Basename; +use Cwd (); +use File::Path; +use Data::Dumper; -my $undef; - -# parse various module $VERSION lines -# these will be reversed later to create %modules -my @modules = ( - $undef => <<'---', # no $VERSION line -package Simple; ---- - $undef => <<'---', # undefined $VERSION -package Simple; -our $VERSION; ---- - '1.23' => <<'---', # declared & defined on same line with 'our' -package Simple; -our $VERSION = '1.23'; ---- - '1.23' => <<'---', # declared & defined on separate lines with 'our' -package Simple; -our $VERSION; -$VERSION = '1.23'; ---- - '1.23' => <<'---', # commented & defined on same line -package Simple; -our $VERSION = '1.23'; # our $VERSION = '4.56'; ---- - '1.23' => <<'---', # commented & defined on separate lines -package Simple; -# our $VERSION = '4.56'; -our $VERSION = '1.23'; ---- - '1.23' => <<'---', # use vars -package Simple; -use vars qw( $VERSION ); -$VERSION = '1.23'; ---- - '1.23' => <<'---', # choose the right default package based on package/file name -package Simple::_private; -$VERSION = '0'; -package Simple; -$VERSION = '1.23'; # this should be chosen for version ---- - '1.23' => <<'---', # just read the first $VERSION line -package Simple; -$VERSION = '1.23'; # we should see this line -$VERSION = eval $VERSION; # and ignore this one ---- - '1.23' => <<'---', # just read the first $VERSION line in reopened package (1) -package Simple; -$VERSION = '1.23'; -package Error::Simple; -$VERSION = '2.34'; -package Simple; ---- - '1.23' => <<'---', # just read the first $VERSION line in reopened package (2) -package Simple; -package Error::Simple; -$VERSION = '2.34'; -package Simple; -$VERSION = '1.23'; ---- - '1.23' => <<'---', # mentions another module's $VERSION -package Simple; -$VERSION = '1.23'; -if ( $Other::VERSION ) { - # whatever -} ---- - '1.23' => <<'---', # mentions another module's $VERSION in a different package -package Simple; -$VERSION = '1.23'; -package Simple2; -if ( $Simple::VERSION ) { - # whatever -} ---- - '1.23' => <<'---', # $VERSION checked only in assignments, not regexp ops -package Simple; -$VERSION = '1.23'; -if ( $VERSION =~ /1\.23/ ) { - # whatever -} ---- - '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops -package Simple; -$VERSION = '1.23'; -if ( $VERSION == 3.45 ) { - # whatever -} ---- - '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops -package Simple; -$VERSION = '1.23'; -package Simple2; -if ( $Simple::VERSION == 3.45 ) { - # whatever -} ---- - '1.23' => <<'---', # Fully qualified $VERSION declared in package -package Simple; -$Simple::VERSION = 1.23; ---- - '1.23' => <<'---', # Differentiate fully qualified $VERSION in a package -package Simple; -$Simple2::VERSION = '999'; -$Simple::VERSION = 1.23; ---- - '1.23' => <<'---', # Differentiate fully qualified $VERSION and unqualified -package Simple; -$Simple2::VERSION = '999'; -$VERSION = 1.23; ---- - '1.23' => <<'---', # $VERSION declared as package variable from within 'main' package -$Simple::VERSION = '1.23'; -{ - package Simple; - $x = $y, $cats = $dogs; -} ---- - '1.23' => <<'---', # $VERSION wrapped in parens - space inside -package Simple; -( $VERSION ) = '1.23'; ---- - '1.23' => <<'---', # $VERSION wrapped in parens - no space inside -package Simple; -($VERSION) = '1.23'; ---- - '1.23' => <<'---', # $VERSION follows a spurious 'package' in a quoted construct -package Simple; -__PACKAGE__->mk_accessors(qw( - program socket proc - package filename line codeline subroutine finished)); - -our $VERSION = "1.23"; ---- - '1.23' => <<'---', # $VERSION using version.pm - package Simple; - use version; our $VERSION = version->new('1.23'); ---- - '1.23' => <<'---', # $VERSION using version.pm and qv() - package Simple; - use version; our $VERSION = qv('1.230'); ---- - '1.23' => <<'---', # Two version assignments, should ignore second one - $Simple::VERSION = '1.230'; - $Simple::VERSION = eval $Simple::VERSION; ---- - '1.23' => <<'---', # declared & defined on same line with 'our' -package Simple; -our $VERSION = '1.23_00_00'; ---- - '1.23' => <<'---', # package NAME VERSION - package Simple 1.23; ---- - '1.23_01' => <<'---', # package NAME VERSION - package Simple 1.23_01; ---- - 'v1.2.3' => <<'---', # package NAME VERSION - package Simple v1.2.3; ---- - 'v1.2_3' => <<'---', # package NAME VERSION - package Simple v1.2_3; ---- - '1.23' => <<'---', # trailing crud - package Simple; - our $VERSION; - $VERSION = '1.23-alpha'; ---- - '1.23' => <<'---', # trailing crud - package Simple; - our $VERSION; - $VERSION = '1.23b'; ---- - '1.234' => <<'---', # multi_underscore - package Simple; - our $VERSION; - $VERSION = '1.2_3_4'; ---- - '0' => <<'---', # non-numeric - package Simple; - our $VERSION; - $VERSION = 'onetwothree'; ---- - $undef => <<'---', # package NAME BLOCK, undef $VERSION -package Simple { - our $VERSION; -} ---- - '1.23' => <<'---', # package NAME BLOCK, with $VERSION -package Simple { - our $VERSION = '1.23'; -} ---- - '1.23' => <<'---', # package NAME VERSION BLOCK -package Simple 1.23 { - 1; -} ---- - 'v1.2.3_4' => <<'---', # package NAME VERSION BLOCK -package Simple v1.2.3_4 { - 1; -} ---- - '0' => <<'---', # set from separately-initialised variable -package Simple; - our $CVSVERSION = '$Revision: 1.7 $'; - our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); -} ---- -); -my %modules = reverse @modules; - -my @pkg_names = ( - [ 'Simple' ] => <<'---', # package NAME -package Simple; ---- - [ 'Simple::Edward' ] => <<'---', # package NAME::SUBNAME -package Simple::Edward; ---- - [ 'Simple::Edward::' ] => <<'---', # package NAME::SUBNAME:: -package Simple::Edward::; ---- - [ "Simple'Edward" ] => <<'---', # package NAME'SUBNAME -package Simple'Edward; ---- - [ "Simple'Edward::" ] => <<'---', # package NAME'SUBNAME:: -package Simple'Edward::; ---- - [ 'Simple::::Edward' ] => <<'---', # package NAME::::SUBNAME -package Simple::::Edward; ---- - [ '::Simple::Edward' ] => <<'---', # package ::NAME::SUBNAME -package ::Simple::Edward; ---- - [ 'main' ] => <<'---', # package NAME:SUBNAME (fail) -package Simple:Edward; ---- - [ 'main' ] => <<'---', # package NAME' (fail) -package Simple'; ---- - [ 'main' ] => <<'---', # package NAME::SUBNAME' (fail) -package Simple::Edward'; ---- - [ 'main' ] => <<'---', # package NAME''SUBNAME (fail) -package Simple''Edward; ---- - [ 'main' ] => <<'---', # package NAME-SUBNAME (fail) -package Simple-Edward; ---- -); -my %pkg_names = reverse @pkg_names; - -plan tests => 54 + (2 * keys( %modules )) + (2 * keys( %pkg_names )); +plan tests => 61; require_ok('Module::Metadata'); -# class method C<find_module_by_name> -my $module = Module::Metadata->find_module_by_name( - 'Module::Metadata' ); -ok( -e $module, 'find_module_by_name() succeeds' ); +{ + # class method C<find_module_by_name> + my $module = Module::Metadata->find_module_by_name( + 'Module::Metadata' ); + ok( -e $module, 'find_module_by_name() succeeds' ); +} ######################### -my $tmp = MBTest->tmpdir; - -use DistGen; -my $dist = DistGen->new( dir => $tmp ); -$dist->regen; - -$dist->chdir_in; - - -# fail on invalid module name -my $pm_info = Module::Metadata->new_from_module( - 'Foo::Bar', inc => [] ); -ok( !defined( $pm_info ), 'fail if can\'t find module by module name' ); - - -# fail on invalid filename -my $file = File::Spec->catfile( 'Foo', 'Bar.pm' ); -$pm_info = Module::Metadata->new_from_file( $file, inc => [] ); -ok( !defined( $pm_info ), 'fail if can\'t find module by file name' ); - - -# construct from module filename -$file = File::Spec->catfile( 'lib', split( /::/, $dist->name ) ) . '.pm'; -$pm_info = Module::Metadata->new_from_file( $file ); -ok( defined( $pm_info ), 'new_from_file() succeeds' ); - -# construct from filehandle -my $handle = IO::File->new($file); -$pm_info = Module::Metadata->new_from_handle( $handle, $file ); -ok( defined( $pm_info ), 'new_from_handle() succeeds' ); -$pm_info = Module::Metadata->new_from_handle( $handle ); -is( $pm_info, undef, "new_from_handle() without filename returns undef" ); -close($handle); - -# construct from module name, using custom include path -$pm_info = Module::Metadata->new_from_module( - $dist->name, inc => [ 'lib', @INC ] ); -ok( defined( $pm_info ), 'new_from_module() succeeds' ); - +BEGIN { + my $cwd = File::Spec->rel2abs(Cwd::cwd); + sub original_cwd { return $cwd } +} -foreach my $module ( sort keys %modules ) { - my $expected = $modules{$module}; - SKIP: { - skip( "No our() support until perl 5.6", 2 ) - if $] < 5.006 && $module =~ /\bour\b/; - skip( "No package NAME VERSION support until perl 5.11.1", 2 ) - if $] < 5.011001 && $module =~ /package\s+[\w\:\']+\s+v?[0-9._]+/; +# Set up a temp directory +sub tmpdir { + my (@args) = @_; + my $dir = $ENV{PERL_CORE} ? original_cwd : File::Spec->tmpdir; + return File::Temp::tempdir('MMD-XXXXXXXX', CLEANUP => 0, DIR => $dir, @args); +} - $dist->change_file( 'lib/Simple.pm', $module ); - $dist->regen; +my $tmp; +BEGIN { $tmp = tmpdir; note "using temp dir $tmp"; } - my $warnings = ''; - local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; - my $pm_info = Module::Metadata->new_from_file( $file ); +END { + die "tests failed; leaving temp dir $tmp behind" + if $ENV{AUTHOR_TESTING} and not Test::Builder->new->is_passing; + note "removing temp dir $tmp"; + chdir original_cwd; + File::Path::rmtree($tmp); +} - # Test::Builder will prematurely numify objects, so use this form - my $errs; - my $got = $pm_info->version; - if ( defined $expected ) { - ok( $got eq $expected, - "correct module version (expected '$expected')" ) - or $errs++; - } else { - ok( !defined($got), - "correct module version (expected undef)" ) - or $errs++; +# generates a new distribution: +# files => { relative filename => $content ... } +# returns the name of the distribution (not including version), +# and the absolute path name to the dist. +{ + my $test_num = 0; + sub new_dist { + my %opts = @_; + + my $distname = 'Simple' . $test_num++; + my $distdir = File::Spec->catdir($tmp, $distname); + note "using dist $distname in $distdir"; + + File::Path::mkpath($distdir) or die "failed to create '$distdir'"; + + foreach my $rel_filename (keys %{$opts{files}}) + { + my $abs_filename = File::Spec->catfile($distdir, $rel_filename); + my $dirname = File::Basename::dirname($abs_filename); + unless (-d $dirname) { + File::Path::mkpath($dirname) or die "Can't create '$dirname'"; + } + + note "creating $abs_filename"; + my $fh = IO::File->new(">$abs_filename") or die "Can't write '$abs_filename'\n"; + print $fh $opts{files}{$rel_filename}; + close $fh; } - is( $warnings, '', 'no warnings from parsing' ) or $errs++; - diag "Got: '$got'\nModule contents:\n$module" if $errs; + + chdir $distdir; + return ($distname, $distdir); } } -# revert to pristine state -$dist->regen( clean => 1 ); - -foreach my $pkg_name ( sort keys %pkg_names ) { - my $expected = $pkg_names{$pkg_name}; +{ + # fail on invalid module name + my $pm_info = Module::Metadata->new_from_module( + 'Foo::Bar', inc => [] ); + ok( !defined( $pm_info ), 'fail if can\'t find module by module name' ); +} - $dist->change_file( 'lib/Simple.pm', $pkg_name ); - $dist->regen; +{ + # fail on invalid filename + my $file = File::Spec->catfile( 'Foo', 'Bar.pm' ); + my $pm_info = Module::Metadata->new_from_file( $file, inc => [] ); + ok( !defined( $pm_info ), 'fail if can\'t find module by file name' ); +} - my $warnings = ''; - local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; - my $pm_info = Module::Metadata->new_from_file( $file ); +{ + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => "package Simple;\n" }); + + # construct from module filename + my $pm_info = Module::Metadata->new_from_file( $file ); + ok( defined( $pm_info ), 'new_from_file() succeeds' ); + + # construct from filehandle + my $handle = IO::File->new($file); + $pm_info = Module::Metadata->new_from_handle( $handle, $file ); + ok( defined( $pm_info ), 'new_from_handle() succeeds' ); + $pm_info = Module::Metadata->new_from_handle( $handle ); + is( $pm_info, undef, "new_from_handle() without filename returns undef" ); + close($handle); +} - # Test::Builder will prematurely numify objects, so use this form - my $errs; - my @got = $pm_info->packages_inside(); - is_deeply( \@got, $expected, - "correct package names (expected '" . join(', ', @$expected) . "')" ) - or $errs++; - is( $warnings, '', 'no warnings from parsing' ) or $errs++; - diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$pkg_name" if $errs; +{ + # construct from module name, using custom include path + my $pm_info = Module::Metadata->new_from_module( + 'Simple', inc => [ 'lib', @INC ] ); + ok( defined( $pm_info ), 'new_from_module() succeeds' ); } -# revert to pristine state -$dist->regen( clean => 1 ); -# Find each package only once -$dist->change_file( 'lib/Simple.pm', <<'---' ); +{ + # Find each package only once + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package Simple; $VERSION = '1.23'; package Error::Simple; @@ -377,50 +132,26 @@ $VERSION = '2.34'; package Simple; --- -$dist->regen; - -$pm_info = Module::Metadata->new_from_file( $file ); - -my @packages = $pm_info->packages_inside; -is( @packages, 2, 'record only one occurence of each package' ); + my $pm_info = Module::Metadata->new_from_file( $file ); + my @packages = $pm_info->packages_inside; + is( @packages, 2, 'record only one occurence of each package' ); +} -# Module 'Simple.pm' does not contain package 'Simple'; -# constructor should not complain, no default module name or version -$dist->change_file( 'lib/Simple.pm', <<'---' ); +{ + # Module 'Simple.pm' does not contain package 'Simple'; + # constructor should not complain, no default module name or version + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package Simple::Not; $VERSION = '1.23'; --- -$dist->regen; -$pm_info = Module::Metadata->new_from_file( $file ); + my $pm_info = Module::Metadata->new_from_file( $file ); -is( $pm_info->name, undef, 'no default package' ); -is( $pm_info->version, undef, 'no version w/o default package' ); - -# Module 'Simple.pm' contains an alpha version -# constructor should report first $VERSION found -$dist->change_file( 'lib/Simple.pm', <<'---' ); -package Simple; -$VERSION = '1.23_01'; -$VERSION = eval $VERSION; ---- - -$dist->regen; -$pm_info = Module::Metadata->new_from_file( $file ); - -is( $pm_info->version, '1.23_01', 'alpha version reported'); - -# NOTE the following test has be done this way because Test::Builder is -# too smart for our own good and tries to see if the version object is a -# dual-var, which breaks with alpha versions: -# Argument "1.23_0100" isn't numeric in addition (+) at -# /usr/lib/perl5/5.8.7/Test/Builder.pm line 505. - -ok( $pm_info->version > 1.23, 'alpha version greater than non'); - -# revert to pristine state -$dist->regen( clean => 1 ); + is( $pm_info->name, undef, 'no default package' ); + is( $pm_info->version, undef, 'no version w/o default package' ); +} # parse $VERSION lines scripts for package main my @scripts = ( @@ -474,18 +205,18 @@ $::VERSION = 0.01; my ( $i, $n ) = ( 1, scalar( @scripts ) ); foreach my $script ( @scripts ) { - $dist->change_file( 'bin/simple.plx', $script ); - $dist->regen; - $pm_info = Module::Metadata->new_from_file( - File::Spec->catfile( 'bin', 'simple.plx' ) ); + my $file = File::Spec->catfile('bin', 'simple.plx'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => $script } ); + my $pm_info = Module::Metadata->new_from_file( $file ); is( $pm_info->version, '0.01', "correct script version ($i of $n)" ); $i++; } - -# examine properties of a module: name, pod, etc -$dist->change_file( 'lib/Simple.pm', <<'---' ); +{ + # examine properties of a module: name, pod, etc + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package Simple; $VERSION = '0.01'; package Simple::Ex; @@ -504,44 +235,42 @@ You can find me on the IRC channel =cut --- -$dist->regen; -$pm_info = Module::Metadata->new_from_module( - $dist->name, inc => [ 'lib', @INC ] ); + my $pm_info = Module::Metadata->new_from_module( + 'Simple', inc => [ 'lib', @INC ] ); -is( $pm_info->name, 'Simple', 'found default package' ); -is( $pm_info->version, '0.01', 'version for default package' ); + is( $pm_info->name, 'Simple', 'found default package' ); + is( $pm_info->version, '0.01', 'version for default package' ); -# got correct version for secondary package -is( $pm_info->version( 'Simple::Ex' ), '0.02', - 'version for secondary package' ); + # got correct version for secondary package + is( $pm_info->version( 'Simple::Ex' ), '0.02', + 'version for secondary package' ); -my $filename = $pm_info->filename; -ok( defined( $filename ) && -e $filename, - 'filename() returns valid path to module file' ); + my $filename = $pm_info->filename; + ok( defined( $filename ) && -e $filename, + 'filename() returns valid path to module file' ); -@packages = $pm_info->packages_inside; -is( @packages, 2, 'found correct number of packages' ); -is( $packages[0], 'Simple', 'packages stored in order found' ); + my @packages = $pm_info->packages_inside; + is( @packages, 2, 'found correct number of packages' ); + is( $packages[0], 'Simple', 'packages stored in order found' ); -# we can detect presence of pod regardless of whether we are collecting it -ok( $pm_info->contains_pod, 'contains_pod() succeeds' ); + # we can detect presence of pod regardless of whether we are collecting it + ok( $pm_info->contains_pod, 'contains_pod() succeeds' ); -my @pod = $pm_info->pod_inside; -is_deeply( \@pod, [qw(NAME AUTHOR)], 'found all pod sections' ); + my @pod = $pm_info->pod_inside; + is_deeply( \@pod, [qw(NAME AUTHOR)], 'found all pod sections' ); -is( $pm_info->pod('NONE') , undef, - 'return undef() if pod section not present' ); + is( $pm_info->pod('NONE') , undef, + 'return undef() if pod section not present' ); -is( $pm_info->pod('NAME'), undef, - 'return undef() if pod section not collected' ); + is( $pm_info->pod('NAME'), undef, + 'return undef() if pod section not collected' ); -# collect_pod -$pm_info = Module::Metadata->new_from_module( - $dist->name, inc => [ 'lib', @INC ], collect_pod => 1 ); + # collect_pod + $pm_info = Module::Metadata->new_from_module( + 'Simple', inc => [ 'lib', @INC ], collect_pod => 1 ); -{ my %pod; for my $section (qw(NAME AUTHOR)) { my $content = $pm_info->pod( $section ); @@ -570,7 +299,8 @@ EXPECTED { # test things that look like POD, but aren't -$dist->change_file( 'lib/Simple.pm', <<'---' ); + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package Simple; =YES THIS STARTS POD @@ -589,15 +319,15 @@ our $VERSION = '666'; our $VERSION = '1.23'; --- - $dist->regen; - $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); + my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '1.23', 'version for default package' ); } { # Make sure processing stops after __DATA__ - $dist->change_file( 'lib/Simple.pm', <<'---' ); + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package Simple; $VERSION = '0.01'; __DATA__ @@ -605,9 +335,8 @@ __DATA__ foo(); }; --- - $dist->regen; - $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); + my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '0.01', 'version for default package' ); my @packages = $pm_info->packages_inside; @@ -616,15 +345,15 @@ __DATA__ { # Make sure we handle version.pm $VERSIONs well - $dist->change_file( 'lib/Simple.pm', <<'---' ); + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); 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; - $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); + my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '0.60.128', 'version for default package' ); my @packages = $pm_info->packages_inside; @@ -634,7 +363,9 @@ $VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]); # check that package_versions_from_directory works -$dist->change_file( 'lib/Simple.pm', <<'---' ); +{ + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package Simple; $VERSION = '0.01'; package Simple::Ex; @@ -659,23 +390,22 @@ Simple Simon =cut --- -$dist->regen; - -my $exp_pvfd = { - 'Simple' => { - 'file' => 'Simple.pm', - 'version' => '0.01' - }, - 'Simple::Ex' => { - 'file' => 'Simple.pm', - 'version' => '0.02' - } -}; -my $got_pvfd = Module::Metadata->package_versions_from_directory('lib'); + my $exp_pvfd = { + 'Simple' => { + 'file' => 'Simple.pm', + 'version' => '0.01' + }, + 'Simple::Ex' => { + 'file' => 'Simple.pm', + 'version' => '0.02' + } + }; + + my $got_pvfd = Module::Metadata->package_versions_from_directory('lib'); -is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" ) - or diag explain $got_pvfd; + is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" ) + or diag explain $got_pvfd; { my $got_provides = Module::Metadata->provides(dir => 'lib', version => 2); @@ -710,22 +440,29 @@ is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" ) is_deeply( $got_provides, $exp_provides, "provides()" ) or diag explain $got_provides; } +} # Check package_versions_from_directory with regard to case-sensitivity { - $dist->change_file( 'lib/Simple.pm', <<'---' ); + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package simple; $VERSION = '0.01'; --- - $dist->regen; - $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); + my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, undef, 'no default package' ); is( $pm_info->version, undef, 'version for default package' ); is( $pm_info->version('simple'), '0.01', 'version for lower-case package' ); is( $pm_info->version('Simple'), undef, 'version for capitalized package' ); + ok( $pm_info->is_indexable(), 'an indexable package is found' ); + ok( $pm_info->is_indexable('simple'), 'the simple package is indexable' ); + ok( !$pm_info->is_indexable('Simple'), 'the Simple package would not be indexed' ); +} - $dist->change_file( 'lib/Simple.pm', <<'---' ); +{ + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); package simple; $VERSION = '0.01'; package Simple; @@ -733,12 +470,28 @@ $VERSION = '0.02'; package SiMpLe; $VERSION = '0.03'; --- - $dist->regen; - $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); + my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '0.02', 'version for default package' ); is( $pm_info->version('simple'), '0.01', 'version for lower-case package' ); is( $pm_info->version('Simple'), '0.02', 'version for capitalized package' ); is( $pm_info->version('SiMpLe'), '0.03', 'version for mixed-case package' ); + ok( $pm_info->is_indexable('simple'), 'the simple package is indexable' ); + ok( $pm_info->is_indexable('Simple'), 'the Simple package is indexable' ); +} + +{ + my $file = File::Spec->catfile('lib', 'Simple.pm'); + my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); +package ## hide from PAUSE + simple; +$VERSION = '0.01'; +--- + + my $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); + is( $pm_info->name, undef, 'no package names found' ); + ok( !$pm_info->is_indexable('simple'), 'the simple package would not be indexed' ); + ok( !$pm_info->is_indexable('Simple'), 'the Simple package would not be indexed' ); + ok( !$pm_info->is_indexable(), 'no indexable package is found' ); } diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/taint.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/taint.t index ef527de50d1..18f0300742a 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/taint.t +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/taint.t @@ -2,8 +2,9 @@ use strict; use warnings; -use 5.008000; # for ${^TAINT} -use Test::More tests => 2; +use Config; +use Test::More $Config{ccflags} =~ /-DSILENT_NO_TAINT_SUPPORT/ + ? ( skip_all => 'No taint support' ) : ( tests => 2 ); use Module::Metadata; use Carp 'croak'; @@ -17,7 +18,8 @@ sub exception(&) { return $@; } -ok(${^TAINT}, 'taint flag is set'); +my $taint_on = ! eval { no warnings; join('',values %ENV), kill 0; 1; }; +ok($taint_on, 'taint flag is set'); # without the fix, we get: # Insecure dependency in eval while running with -T switch at lib/Module/Metadata.pm line 668, <GEN0> line 15. diff --git a/gnu/usr.bin/perl/cpan/Module-Metadata/t/version.t b/gnu/usr.bin/perl/cpan/Module-Metadata/t/version.t index e523f97a0f4..f97a19d1cbb 100644 --- a/gnu/usr.bin/perl/cpan/Module-Metadata/t/version.t +++ b/gnu/usr.bin/perl/cpan/Module-Metadata/t/version.t @@ -7,14 +7,15 @@ use lib "t/lib/0_2"; plan tests => 4; require Foo; -is $Foo::VERSION, 0.2; +is($Foo::VERSION, 0.2, 'affirmed version of loaded module'); my $meta = Module::Metadata->new_from_module("Foo", inc => [ "t/lib/0_1" ] ); -is $meta->version, 0.1; +is($meta->version, 0.1, 'extracted proper version from scanned module'); -is $Foo::VERSION, 0.2; +is($Foo::VERSION, 0.2, 'loaded module still retains its version'); -ok eval "use Foo 0.2; 1"; +ok(eval "use Foo 0.2; 1", 'successfully loaded module again') + or diag 'got exception: ', $@; |