diff options
Diffstat (limited to 'gnu/usr.bin/perl/cpan/Module-Build')
5 files changed, 18 insertions, 1161 deletions
diff --git a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm index 86cfdbc86bf..a4c66853e89 100644 --- a/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm +++ b/gnu/usr.bin/perl/cpan/Module-Build/lib/Module/Build/ModuleInfo.pm @@ -2,390 +2,13 @@ # vim:ts=8:sw=2:et:sta:sts=2 package Module::Build::ModuleInfo; -# This module provides routines to gather information about -# perl modules (assuming this may be expanded in the distant -# parrot future to look at other types of modules). - use strict; use vars qw($VERSION); -$VERSION = '0.3603'; +$VERSION = '0.39_01'; $VERSION = eval $VERSION; -use File::Spec; -use IO::File; -use Module::Build::Version; - -my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal - -my $PKG_REGEXP = qr{ # match a package declaration - ^[\s\{;]* # intro chars on a line - package # the word 'package' - \s+ # whitespace - ([\w:]+) # a package name - \s* # optional whitespace - ($V_NUM_REGEXP)? # optional version number - \s* # optional whitesapce - ; # semicolon line terminator -}x; - -my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name - ([\$*]) # sigil - $ or * - ( - ( # optional leading package name - (?:::|\')? # possibly starting like just :: (Ì la $::VERSION) - (?:\w+(?:::|\'))* # Foo::Bar:: ... - )? - VERSION - )\b -}x; - -my $VERS_REGEXP = qr{ # match a VERSION definition - (?: - \(\s*$VARNAME_REGEXP\s*\) # with parens - | - $VARNAME_REGEXP # without parens - ) - \s* - =[^=~] # = but not ==, nor =~ -}x; - - -sub new_from_file { - my $class = shift; - my $filename = File::Spec->rel2abs( shift ); - - return undef unless defined( $filename ) && -f $filename; - return $class->_init(undef, $filename, @_); -} - -sub new_from_module { - my $class = shift; - my $module = shift; - my %props = @_; - - $props{inc} ||= \@INC; - my $filename = $class->find_module_by_name( $module, $props{inc} ); - return undef unless defined( $filename ) && -f $filename; - return $class->_init($module, $filename, %props); -} - -sub _init { - my $class = shift; - my $module = shift; - my $filename = shift; - my %props = @_; - - my( %valid_props, @valid_props ); - @valid_props = qw( collect_pod inc ); - @valid_props{@valid_props} = delete( @props{@valid_props} ); - warn "Unknown properties: @{[keys %props]}\n" if scalar( %props ); - - my %data = ( - module => $module, - filename => $filename, - version => undef, - packages => [], - versions => {}, - pod => {}, - pod_headings => [], - collect_pod => 0, - - %valid_props, - ); - - my $self = bless(\%data, $class); - - $self->_parse_file(); - - unless($self->{module} and length($self->{module})) { - my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); - if($f =~ /\.pm$/) { - $f =~ s/\..+$//; - my @candidates = grep /$f$/, @{$self->{packages}}; - $self->{module} = shift(@candidates); # punt - } - else { - if(grep /main/, @{$self->{packages}}) { - $self->{module} = 'main'; - } - else { - $self->{module} = $self->{packages}[0] || ''; - } - } - } - - $self->{version} = $self->{versions}{$self->{module}} - if defined( $self->{module} ); - - return $self; -} - -# class method -sub _do_find_module { - my $class = shift; - my $module = shift || die 'find_module_by_name() requires a package name'; - my $dirs = shift || \@INC; - - my $file = File::Spec->catfile(split( /::/, $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"; - } - return; -} - -# class method -sub find_module_by_name { - my $found = shift()->_do_find_module(@_) or return; - return $found->[0]; -} - -# class method -sub find_module_dir_by_name { - my $found = shift()->_do_find_module(@_) or return; - return $found->[1]; -} - - -# given a line of perl code, attempt to parse it if it looks like a -# $VERSION assignment, returning sigil, full name, & package name -sub _parse_version_expression { - my $self = shift; - my $line = shift; - - my( $sig, $var, $pkg ); - if ( $line =~ $VERS_REGEXP ) { - ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); - if ( $pkg ) { - $pkg = ($pkg eq '::') ? 'main' : $pkg; - $pkg =~ s/::$//; - } - } - - return ( $sig, $var, $pkg ); -} - -sub _parse_file { - my $self = shift; - - my $filename = $self->{filename}; - my $fh = IO::File->new( $filename ) - or die( "Can't open '$filename': $!" ); - - $self->_parse_fh($fh); -} - -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 $pod_sect = ''; - my $pod_data = ''; - - while (defined( my $line = <$fh> )) { - my $line_num = $.; - - chomp( $line ); - next if $line =~ /^\s*#/; - - $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod; - - # Would be nice if we could also check $in_string or something too - last if !$in_pod && $line =~ /^__(?:DATA|END)__$/; - - if ( $in_pod || $line =~ /^=cut/ ) { - - if ( $line =~ /^=head\d\s+(.+)\s*$/ ) { - 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"; - - } - - } else { - - $pod_sect = ''; - $pod_data = ''; - - # parse $line to see if it's a $VERSION declaration - my( $vers_sig, $vers_fullname, $vers_pkg ) = - $self->_parse_version_expression( $line ); - - if ( $line =~ $PKG_REGEXP ) { - $pkg = $1; - push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); - $vers{$pkg} = (defined $2 ? $2 : undef) 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 ); - } else { - # Warn unless the user is using the "$VERSION = eval - # $VERSION" idiom (though there are probably other idioms - # that we should watch out for...) - warn <<"EOM" unless $line =~ /=\s*eval/; -Package '$vers_pkg' already declared with version '$vers{$vers_pkg}', -ignoring subsequent declaration on line $line_num. -EOM - } - - # 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; - } else { - warn <<"EOM"; -Package '$pkg' already declared with version '$vers{$pkg}' -ignoring new version '$v' on line $line_num. -EOM - } - - } - - } - - } - - if ( $self->{collect_pod} && length($pod_data) ) { - $pod{$pod_sect} = $pod_data; - } - - $self->{versions} = \%vers; - $self->{packages} = \@pkgs; - $self->{pod} = \%pod; - $self->{pod_headings} = \@pod; -} - -{ -my $pn = 0; -sub _evaluate_version_line { - my $self = shift; - my( $sigil, $var, $line ) = @_; - - # Some of this code came from the ExtUtils:: hierarchy. - - # We compile into $vsub because 'use version' would cause - # compiletime/runtime issues with local() - my $vsub; - $pn++; # everybody gets their own package - my $eval = qq{BEGIN { q# Hide from _packages_inside() - #; package Module::Build::ModuleInfo::_version::p$pn; - use Module::Build::Version; - no strict; - - local $sigil$var; - \$$var=undef; - \$vsub = sub { - $line; - \$$var - }; - }}; - - local $^W; - # Try to get the $VERSION - eval $eval; - # some modules say $VERSION = $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; - } - warn "Error evaling version line '$eval' in $self->{filename}: $@\n" - if $@; - (ref($vsub) eq 'CODE') or - die "failed to build version sub for $self->{filename}"; - my $result = eval { $vsub->() }; - die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" - if $@; - - # Activestate apparently creates custom versions like '1.23_45_01', which - # cause M::B::Version to think it's an invalid alpha. So check for that - # and strip them - my $num_dots = () = $result =~ m{\.}g; - my $num_unders = () = $result =~ m{_}g; - if ( substr($result,0,1) ne 'v' && $num_dots < 2 && $num_unders > 1 ) { - $result =~ s{_}{}g; - } - - # Bless it into our own version class - eval { $result = Module::Build::Version->new($result) }; - die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" - if $@; - - return $result; -} -} - - -############################################################ - -# accessors -sub name { $_[0]->{module} } - -sub filename { $_[0]->{filename} } -sub packages_inside { @{$_[0]->{packages}} } -sub pod_inside { @{$_[0]->{pod_headings}} } -sub contains_pod { $#{$_[0]->{pod_headings}} } - -sub version { - my $self = shift; - my $mod = shift || $self->{module}; - my $vers; - if ( defined( $mod ) && length( $mod ) && - exists( $self->{versions}{$mod} ) ) { - return $self->{versions}{$mod}; - } else { - return undef; - } -} - -sub pod { - my $self = shift; - my $sect = shift; - if ( defined( $sect ) && length( $sect ) && - exists( $self->{pod}{$sect} ) ) { - return $self->{pod}{$sect}; - } else { - return undef; - } -} +require Module::Metadata; +our @ISA = qw/Module::Metadata/; 1; @@ -395,97 +18,17 @@ __END__ =head1 NAME -Module::Build::ModuleInfo - Gather package and POD information from a perl module file - +Module::Build::ModuleInfo - DEPRECATED =head1 DESCRIPTION -=over 4 - -=item new_from_file($filename, collect_pod => 1) - -Construct a C<ModuleInfo> object given the path to a file. Takes an optional -argument C<collect_pod> which is a boolean that determines whether -POD data is collected and stored for reference. POD data is not -collected by default. POD headings are always collected. - -=item new_from_module($module, collect_pod => 1, inc => \@dirs) - -Construct a C<ModuleInfo> object given a module or package name. In addition -to accepting the C<collect_pod> argument as described above, this -method accepts a C<inc> argument which is a reference to an array of -of directories to search for the module. If none are given, the -default is @INC. - -=item 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 -filename. If it's a script (i.e. not a *.pm) the package name is -'main'. - -=item 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 filename() - -Returns the absolute path to the file. - -=item packages_inside() - -Returns a list of packages. - -=item pod_inside() - -Returns a list of POD sections. - -=item contains_pod() - -Returns true if there is any POD in the file. - -=item pod($section) - -Returns the POD data in the given section. - -=item 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 -@INC is searched. - -Can be called as either an object or a class method. - -=item 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 -optional parameter, otherwise @INC is searched. - -Can be called as either an object or a class method. - -=back - - -=head1 AUTHOR - -Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org> - - -=head1 COPYRIGHT - -Copyright (c) 2001-2006 Ken Williams. All rights reserved. - -This library is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - +This module has been extracted into a separate distribution and renamed +L<Module::Metadata>. This module is kept as a subclass wrapper for +compatibility. =head1 SEE ALSO -perl(1), L<Module::Build>(3) +perl(1), L<Module::Build>, L<Module::Metadata> =cut diff --git a/gnu/usr.bin/perl/cpan/Module-Build/scripts/config_data b/gnu/usr.bin/perl/cpan/Module-Build/scripts/config_data deleted file mode 100644 index 489cb4519cf..00000000000 --- a/gnu/usr.bin/perl/cpan/Module-Build/scripts/config_data +++ /dev/null @@ -1,252 +0,0 @@ -#!/opt/perl/5.10.1/bin/perl - -eval 'exec /opt/perl/5.10.1/bin/perl -S $0 ${1+"$@"}' - if 0; # not running under some shell - -use strict; -use Module::Build 0.25; -use Getopt::Long; - -my %opt_defs = ( - module => {type => '=s', - desc => 'The name of the module to configure (required)'}, - feature => {type => ':s', - desc => 'Print the value of a feature or all features'}, - config => {type => ':s', - desc => 'Print the value of a config option'}, - set_feature => {type => '=s%', - desc => "Set a feature to 'true' or 'false'"}, - set_config => {type => '=s%', - desc => 'Set a config option to the given value'}, - eval => {type => '', - desc => 'eval() config values before setting'}, - help => {type => '', - desc => 'Print a help message and exit'}, - ); - -my %opts; -GetOptions( \%opts, map "$_$opt_defs{$_}{type}", keys %opt_defs ) or die usage(%opt_defs); -print usage(%opt_defs) and exit(0) - if $opts{help}; - -my @exclusive = qw(feature config set_feature set_config); -die "Exactly one of the options '" . join("', '", @exclusive) . "' must be specified\n" . usage(%opt_defs) - unless grep(exists $opts{$_}, @exclusive) == 1; - -die "Option --module is required\n" . usage(%opt_defs) - unless $opts{module}; - -my $cf = load_config($opts{module}); - -if (exists $opts{feature}) { - - if (length $opts{feature}) { - print $cf->feature($opts{feature}); - } else { - my %auto; - # note: need to support older ConfigData.pm's - @auto{$cf->auto_feature_names} = () if $cf->can("auto_feature_names"); - - print " Features defined in $cf:\n"; - foreach my $name (sort $cf->feature_names) { - print " $name => ", $cf->feature($name), (exists $auto{$name} ? " (dynamic)" : ""), "\n"; - } - } - -} elsif (exists $opts{config}) { - - require Data::Dumper; - local $Data::Dumper::Terse = 1; - - if (length $opts{config}) { - print Data::Dumper::Dumper($cf->config($opts{config})), "\n"; - } else { - print " Configuration defined in $cf:\n"; - foreach my $name (sort $cf->config_names) { - print " $name => ", Data::Dumper::Dumper($cf->config($name)), "\n"; - } - } - -} elsif (exists $opts{set_feature}) { - my %to_set = %{$opts{set_feature}}; - while (my ($k, $v) = each %to_set) { - die "Feature value must be 0 or 1\n" unless $v =~ /^[01]$/; - $cf->set_feature($k, 0+$v); # Cast to a number, not a string - } - $cf->write; - print "Feature" . 's'x(keys(%to_set)>1) . " saved\n"; - -} elsif (exists $opts{set_config}) { - - my %to_set = %{$opts{set_config}}; - while (my ($k, $v) = each %to_set) { - if ($opts{eval}) { - $v = eval($v); - die $@ if $@; - } - $cf->set_config($k, $v); - } - $cf->write; - print "Config value" . 's'x(keys(%to_set)>1) . " saved\n"; -} - -sub load_config { - my $mod = shift; - - $mod =~ /^([\w:]+)$/ - or die "Invalid module name '$mod'"; - - my $cf = $mod . "::ConfigData"; - eval "require $cf"; - die $@ if $@; - - return $cf; -} - -sub usage { - my %defs = @_; - - my $out = "\nUsage: $0 [options]\n\n Options include:\n"; - - foreach my $name (sort keys %defs) { - $out .= " --$name"; - - for ($defs{$name}{type}) { - /^=s$/ and $out .= " <string>"; - /^=s%$/ and $out .= " <string>=<value>"; - } - - pad_line($out, 35); - $out .= "$defs{$name}{desc}\n"; - } - - $out .= <<EOF; - - Examples: - $0 --module Foo::Bar --feature bazzable - $0 --module Foo::Bar --config magic_number - $0 --module Foo::Bar --set_feature bazzable=1 - $0 --module Foo::Bar --set_config magic_number=42 - -EOF - - return $out; -} - -sub pad_line { $_[0] .= ' ' x ($_[1] - length($_[0]) + rindex($_[0], "\n")) } - - -__END__ - -=head1 NAME - -config_data - Query or change configuration of Perl modules - -=head1 SYNOPSIS - - # Get config/feature values - config_data --module Foo::Bar --feature bazzable - config_data --module Foo::Bar --config magic_number - - # Set config/feature values - config_data --module Foo::Bar --set_feature bazzable=1 - config_data --module Foo::Bar --set_config magic_number=42 - - # Print a usage message - config_data --help - -=head1 DESCRIPTION - -The C<config_data> tool provides a command-line interface to the -configuration of Perl modules. By "configuration", we mean something -akin to "user preferences" or "local settings". This is a -formalization and abstraction of the systems that people like Andreas -Koenig (C<CPAN::Config>), Jon Swartz (C<HTML::Mason::Config>), Andy -Wardley (C<Template::Config>), and Larry Wall (perl's own Config.pm) -have developed independently. - -The configuration system emplyed here was developed in the context of -C<Module::Build>. Under this system, configuration information for a -module C<Foo>, for example, is stored in a module called -C<Foo::ConfigData>) (I would have called it C<Foo::Config>, but that -was taken by all those other systems mentioned in the previous -paragraph...). These C<...::ConfigData> modules contain the -configuration data, as well as publically accessible methods for -querying and setting (yes, actually re-writing) the configuration -data. The C<config_data> script (whose docs you are currently -reading) is merely a front-end for those methods. If you wish, you -may create alternate front-ends. - -The two types of data that may be stored are called C<config> values -and C<feature> values. A C<config> value may be any perl scalar, -including references to complex data structures. It must, however, be -serializable using C<Data::Dumper>. A C<feature> is a boolean (1 or -0) value. - -=head1 USAGE - -This script functions as a basic getter/setter wrapper around the -configuration of a single module. On the command line, specify which -module's configuration you're interested in, and pass options to get -or set C<config> or C<feature> values. The following options are -supported: - -=over 4 - -=item module - -Specifies the name of the module to configure (required). - -=item feature - -When passed the name of a C<feature>, shows its value. The value will -be 1 if the feature is enabled, 0 if the feature is not enabled, or -empty if the feature is unknown. When no feature name is supplied, -the names and values of all known features will be shown. - -=item config - -When passed the name of a C<config> entry, shows its value. The value -will be displayed using C<Data::Dumper> (or similar) as perl code. -When no config name is supplied, the names and values of all known -config entries will be shown. - -=item set_feature - -Sets the given C<feature> to the given boolean value. Specify the value -as either 1 or 0. - -=item set_config - -Sets the given C<config> entry to the given value. - -=item eval - -If the C<--eval> option is used, the values in C<set_config> will be -evaluated as perl code before being stored. This allows moderately -complicated data structures to be stored. For really complicated -structures, you probably shouldn't use this command-line interface, -just use the Perl API instead. - -=item help - -Prints a help message, including a few examples, and exits. - -=back - -=head1 AUTHOR - -Ken Williams, kwilliams@cpan.org - -=head1 COPYRIGHT - -Copyright (c) 1999, Ken Williams. All rights reserved. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -Module::Build(3), perl(1). - -=cut diff --git a/gnu/usr.bin/perl/cpan/Module-Build/t/bundled/Tie/CPHash.pm b/gnu/usr.bin/perl/cpan/Module-Build/t/bundled/Tie/CPHash.pm index 36aea85a8cc..b1676221cc9 100644 --- a/gnu/usr.bin/perl/cpan/Module-Build/t/bundled/Tie/CPHash.pm +++ b/gnu/usr.bin/perl/cpan/Module-Build/t/bundled/Tie/CPHash.pm @@ -5,7 +5,7 @@ package Tie::CPHash; # # Author: Christopher J. Madsen <cjm@pobox.com> # Created: 08 Nov 1997 -# $Revision: 5841 $ $Date: 2006-03-21 08:27:29 -0500 (Tue, 21 Mar 2006) $ +# $Revision$ $Date$ # # This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. diff --git a/gnu/usr.bin/perl/cpan/Module-Build/t/metadata.t b/gnu/usr.bin/perl/cpan/Module-Build/t/metadata.t index 1ac35b28c47..a495f157b43 100755 --- a/gnu/usr.bin/perl/cpan/Module-Build/t/metadata.t +++ b/gnu/usr.bin/perl/cpan/Module-Build/t/metadata.t @@ -2,7 +2,7 @@ use strict; use lib 't/lib'; -use MBTest tests => 51; +use MBTest tests => 52; blib_load('Module::Build'); blib_load('Module::Build::ConfigData'); @@ -65,7 +65,13 @@ my $mb = Module::Build->new_from_context; my $mb_config_req = { 'Module::Build' => int($Module::Build::VERSION * 100)/100 }; - my $node = $mb->get_metadata( ); + my $node; + my $output = stdout_stderr_of( sub { + $node = $mb->get_metadata( auto => 1 ); + }); + like( $output, qr/Module::Build was not found in configure_requires/, + "saw warning about M::B not in configure_requires" + ); # exists() doesn't seem to work here is $node->{name}, $metadata{module_name}; @@ -86,7 +92,7 @@ my $mb = Module::Build->new_from_context; { my $mb_prereq = { 'Module::Build' => 0 }; $mb->configure_requires( $mb_prereq ); - my $node = $mb->get_metadata( ); + my $node = $mb->get_metadata( auto => 1 ); # exists() doesn't seem to work here diff --git a/gnu/usr.bin/perl/cpan/Module-Build/t/moduleinfo.t b/gnu/usr.bin/perl/cpan/Module-Build/t/moduleinfo.t deleted file mode 100755 index e28726d493a..00000000000 --- a/gnu/usr.bin/perl/cpan/Module-Build/t/moduleinfo.t +++ /dev/null @@ -1,440 +0,0 @@ -#!/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 lib 't/lib'; -use MBTest; - -# parse various module $VERSION lines -# these will be reversed later to create %modules -my @modules = ( - '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' => <<'---', # 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; ---- -); -my %modules = reverse @modules; - -plan tests => 36 + 2 * keys( %modules ); - -blib_load('Module::Build::ModuleInfo'); - -my $tmp = MBTest->tmpdir; - -use DistGen; -my $dist = DistGen->new( dir => $tmp ); -$dist->regen; - -$dist->chdir_in; - -######################### - -# class method C<find_module_by_name> -my $module = Module::Build::ModuleInfo->find_module_by_name( - 'Module::Build::ModuleInfo' ); -ok( -e $module, 'find_module_by_name() succeeds' ); - - -# fail on invalid module name -my $pm_info = Module::Build::ModuleInfo->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::Build::ModuleInfo->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::Build::ModuleInfo->new_from_file( $file ); -ok( defined( $pm_info ), 'new_from_file() succeeds' ); - -# construct from module name, using custom include path -$pm_info = Module::Build::ModuleInfo->new_from_module( - $dist->name, inc => [ 'lib', @INC ] ); -ok( defined( $pm_info ), 'new_from_module() succeeds' ); - - -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._]+/; - - $dist->change_file( 'lib/Simple.pm', $module ); - $dist->regen; - - my $warnings = ''; - local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; - my $pm_info = Module::Build::ModuleInfo->new_from_file( $file ); - - # Test::Builder will prematurely numify objects, so use this form - my $errs; - ok( $pm_info->version eq $expected, - "correct module version (expected '$expected')" ) - or $errs++; - is( $warnings, '', 'no warnings from parsing' ) or $errs++; - diag "Got: '@{[$pm_info->version]}'\nModule contents:\n$module" if $errs; - } -} - -# revert to pristine state -$dist->regen( clean => 1 ); - -# Find each package only once -$dist->change_file( 'lib/Simple.pm', <<'---' ); -package Simple; -$VERSION = '1.23'; -package Error::Simple; -$VERSION = '2.34'; -package Simple; ---- - -$dist->regen; - -$pm_info = Module::Build::ModuleInfo->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', <<'---' ); -package Simple::Not; -$VERSION = '1.23'; ---- - -$dist->regen; -$pm_info = Module::Build::ModuleInfo->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::Build::ModuleInfo->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 ); - -# parse $VERSION lines scripts for package main -my @scripts = ( - <<'---', # package main declared -#!perl -w -package main; -$VERSION = '0.01'; ---- - <<'---', # on first non-comment line, non declared package main -#!perl -w -$VERSION = '0.01'; ---- - <<'---', # after non-comment line -#!perl -w -use strict; -$VERSION = '0.01'; ---- - <<'---', # 1st declared package -#!perl -w -package main; -$VERSION = '0.01'; -package _private; -$VERSION = '999'; ---- - <<'---', # 2nd declared package -#!perl -w -package _private; -$VERSION = '999'; -package main; -$VERSION = '0.01'; ---- - <<'---', # split package -#!perl -w -package main; -package _private; -$VERSION = '999'; -package main; -$VERSION = '0.01'; ---- - <<'---', # define 'main' version from other package -package _private; -$::VERSION = 0.01; -$VERSION = '999'; ---- - <<'---', # define 'main' version from other package -package _private; -$VERSION = '999'; -$::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::Build::ModuleInfo->new_from_file( - File::Spec->catfile( 'bin', 'simple.plx' ) ); - - 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', <<'---' ); -package Simple; -$VERSION = '0.01'; -package Simple::Ex; -$VERSION = '0.02'; -=head1 NAME - -Simple - It's easy. - -=head1 AUTHOR - -Simple Simon - -=cut ---- -$dist->regen; - -$pm_info = Module::Build::ModuleInfo->new_from_module( - $dist->name, inc => [ 'lib', @INC ] ); - -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' ); - -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' ); - -# 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' ); - -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' ); - - -# collect_pod -$pm_info = Module::Build::ModuleInfo->new_from_module( - $dist->name, inc => [ 'lib', @INC ], collect_pod => 1 ); - -my $name = $pm_info->pod('NAME'); -if ( $name ) { - $name =~ s/^\s+//; - $name =~ s/\s+$//; -} -is( $name, q|Simple - It's easy.|, 'collected pod section' ); - - -{ - # Make sure processing stops after __DATA__ - $dist->change_file( 'lib/Simple.pm', <<'---' ); -package Simple; -$VERSION = '0.01'; -__DATA__ -*UNIVERSAL::VERSION = sub { - foo(); -}; ---- - $dist->regen; - - $pm_info = Module::Build::ModuleInfo->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; - is_deeply(\@packages, ['Simple'], 'packages inside'); -} - -{ - # Make sure we handle version.pm $VERSIONs well - $dist->change_file( 'lib/Simple.pm', <<'---' ); -package Simple; -$VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]); -package Simple::Simon; -$VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]); ---- - $dist->regen; - - $pm_info = Module::Build::ModuleInfo->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; - is_deeply([sort @packages], ['Simple', 'Simple::Simon'], 'packages inside'); - is( $pm_info->version('Simple::Simon'), '0.61.129', 'version for embedded package' ); -} - |