diff options
| -rw-r--r-- | lib/Module/Build.pm | 11 | ||||
| -rw-r--r-- | lib/Module/Build/API.pod | 2 | ||||
| -rw-r--r-- | lib/Module/Build/Authoring.pod | 2 | ||||
| -rw-r--r-- | lib/Module/Build/Base.pm | 27 | ||||
| -rw-r--r-- | lib/Module/Build/Changes | 40 | ||||
| -rw-r--r-- | lib/Module/Build/ModuleInfo.pm | 3 | ||||
| -rw-r--r-- | lib/Module/Build/Platform/MacOS.pm | 3 | ||||
| -rw-r--r-- | lib/Module/Build/Version.pm | 508 | ||||
| -rw-r--r-- | lib/Module/Build/t/moduleinfo.t | 28 |
9 files changed, 606 insertions, 18 deletions
diff --git a/lib/Module/Build.pm b/lib/Module/Build.pm index 5e9c777764..0ad0a92013 100644 --- a/lib/Module/Build.pm +++ b/lib/Module/Build.pm @@ -15,7 +15,7 @@ use Module::Build::Base; use vars qw($VERSION @ISA); @ISA = qw(Module::Build::Base); -$VERSION = '0.2803'; +$VERSION = '0.2805'; $VERSION = eval $VERSION; # Okay, this is the brute-force method of finding out what kind of @@ -660,6 +660,13 @@ false to prevent the custom resource file from being loaded. Display extra information about the Build on output. +=item allow_mb_mismatch + +Suppresses the check upon startup that the version of Module::Build +we're now running under is the same version that was initially invoked +when building the distribution (i.e. when the C<Build.PL> script was +first run). Use with caution. + =back @@ -980,7 +987,7 @@ signature or the like, if available. See C<cons> for an example. Ken Williams <kwilliams@cpan.org> Development questions, bug reports, and patches should be sent to the -Module-Build mailing list at <module-build-general@lists.sourceforge.net>. +Module-Build mailing list at <module-build@perl.org>. Bug reports are also welcome at <http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>. diff --git a/lib/Module/Build/API.pod b/lib/Module/Build/API.pod index a98fa203e6..1737d89149 100644 --- a/lib/Module/Build/API.pod +++ b/lib/Module/Build/API.pod @@ -1526,6 +1526,8 @@ accessor methods for the following properties: =item PL_files() +=item allow_mb_mismatch() + =item autosplit() =item base_dir() diff --git a/lib/Module/Build/Authoring.pod b/lib/Module/Build/Authoring.pod index a925d87097..e9bbceba01 100644 --- a/lib/Module/Build/Authoring.pod +++ b/lib/Module/Build/Authoring.pod @@ -259,7 +259,7 @@ compatibility layers. Ken Williams <kwilliams@cpan.org> Development questions, bug reports, and patches should be sent to the -Module-Build mailing list at <module-build-general@lists.sourceforge.net>. +Module-Build mailing list at <module-build@perl.org>. Bug reports are also welcome at <http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>. diff --git a/lib/Module/Build/Base.pm b/lib/Module/Build/Base.pm index 5007da2a77..67d2ac08ba 100644 --- a/lib/Module/Build/Base.pm +++ b/lib/Module/Build/Base.pm @@ -68,12 +68,15 @@ sub resume { " but we are now using '$perl'.\n"); } - my $mb_version = $Module::Build::VERSION; - die(" * ERROR: Configuration was initially created with Module::Build version '$self->{properties}{mb_version}',\n". - " but we are now using version '$mb_version'. Please re-run the Build.PL or Makefile.PL script.\n") - unless $mb_version eq $self->{properties}{mb_version}; - $self->cull_args(@ARGV); + + unless ($self->allow_mb_mismatch) { + my $mb_version = $Module::Build::VERSION; + die(" * ERROR: Configuration was initially created with Module::Build version '$self->{properties}{mb_version}',\n". + " but we are now using version '$mb_version'. Please re-run the Build.PL or Makefile.PL script.\n") + if $mb_version ne $self->{properties}{mb_version}; + } + $self->{invoked_action} = $self->{action} ||= 'build'; return $self; @@ -755,6 +758,7 @@ __PACKAGE__->add_property(metafile => 'META.yml'); __PACKAGE__->add_property(recurse_into => []); __PACKAGE__->add_property(use_rcfile => 1); __PACKAGE__->add_property(create_packlist => 1); +__PACKAGE__->add_property(allow_mb_mismatch => 0); { my $Is_ActivePerl = eval {require ActivePerl::DocTools}; @@ -1089,7 +1093,7 @@ sub prereq_failures { } elsif ($type =~ /^(?:\w+_)?recommends$/) { next if $status->{ok}; - $status->{message} = ($status->{have} eq '<none>' + $status->{message} = (!ref($status->{have}) && $status->{have} eq '<none>' ? "Optional prerequisite $modname is not installed" : "$modname ($status->{have}) is installed, but we prefer to have $spec"); } else { @@ -3211,8 +3215,7 @@ sub prepare_metadata { die "ERROR: Missing required field '$_' for META.yml\n" unless defined($node->{$name}) && length($node->{$name}); } - # Really don't understand why I need the "... if exists" here - $node->{version} = $node->{version}->stringify if exists $node->{version}; + $node->{version} = '' . $node->{version}; # Stringify version objects if (defined( $self->license ) && defined( my $url = $self->valid_licenses->{ $self->license } )) { @@ -3929,7 +3932,13 @@ sub process_xs { sub do_system { my ($self, @cmd) = @_; $self->log_info("@cmd\n"); - return !system(@cmd); + my $status = system(@cmd); + if ($status and $! =~ /Argument list too long/i) { + my $env_entries = ''; + foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " } + warn "'Argument list' was 'too long', env lengths are $env_entries"; + } + return !$status; } sub copy_if_modified { diff --git a/lib/Module/Build/Changes b/lib/Module/Build/Changes index 6a0959b9f2..f7b14badf7 100644 --- a/lib/Module/Build/Changes +++ b/lib/Module/Build/Changes @@ -1,5 +1,45 @@ Revision history for Perl extension Module::Build. +0.2805 Sat Jul 29 22:01:24 CDT 2006 + + - We now embed a copy of version.pm right in the + Module::Build::Version source code, with John Peacock's blessing, + in case the user has a rough time installing version.pm. This + helps alleviate troubles people were still having with working out + a seemingly circular dependency (even though version.pm now ships + with a standard Makefile.PL too). A version.pm >= 0.661 installed + on the system will take precedence over our bundled one. [John + Peacock] + + - Fix some test warnings (or failures?) related to version.pm + numification. [John Peacock] + + - The top-level 'version' entry in META.yml files we'd generated was + in the wrong format (it was being treated as a version.pm object + rather than a serialized copy) due to a weird YAML::Node issue. + Fixed. + + - Don't 'use base qw(version)' anymore in our M::B::Version wrapper, + just set @ISA directly, because some people have reported that the + 'use base' line is croaking. + + - Added an 'allow_mb_mismatch' parameter to suppress the startup + check that ensures the version of M::B currently running is the + same as the one initially used to run the Build.PL. Use with + caution. + + - Module::Build::ModuleInfo will no longer detect things that look + like $VERSION assignments after an __END__ or __DATA__ token. + + - Updated documentation to mention the new mailing list on perl.org + rather than the old one on sourceforge. + +0.2804 Sun Jul 16 16:41:25 CDT 2006 + + - Added 'use version;' in Module::Build::Version, because some + versions of base.pm won't automatically load version.pm when we do + 'use base qw/version/;'. [Spotted by Erik Tank] + 0.2803 Sat Jul 15 08:26:34 CDT 2006 - The META.yml file in the last release was all screwed up, so the diff --git a/lib/Module/Build/ModuleInfo.pm b/lib/Module/Build/ModuleInfo.pm index 471f80b878..5021ef1371 100644 --- a/lib/Module/Build/ModuleInfo.pm +++ b/lib/Module/Build/ModuleInfo.pm @@ -176,6 +176,9 @@ sub _parse_file { $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*$/ ) { diff --git a/lib/Module/Build/Platform/MacOS.pm b/lib/Module/Build/Platform/MacOS.pm index 8a095477cf..7927cca6f0 100644 --- a/lib/Module/Build/Platform/MacOS.pm +++ b/lib/Module/Build/Platform/MacOS.pm @@ -2,7 +2,8 @@ package Module::Build::Platform::MacOS; use strict; use Module::Build::Base; -use base qw(Module::Build::Base); +use vars qw(@ISA); +@ISA = qw(Module::Build::Base); use ExtUtils::Install; diff --git a/lib/Module/Build/Version.pm b/lib/Module/Build/Version.pm index f814746cfb..17a582a146 100644 --- a/lib/Module/Build/Version.pm +++ b/lib/Module/Build/Version.pm @@ -1,5 +1,39 @@ package Module::Build::Version; -use base qw/version/; +use strict; + +eval "use version 0.661"; +if ($@) { # can't locate version files, use our own + + # Avoid redefined warnings if an old version.pm was available + delete $version::{$_} foreach keys %version::; + + # first we get the stub version module + my $version; + while (<DATA>) { + s/(\$VERSION)\s=\s\d+/\$VERSION = 0/; + $version .= $_ if $_; + last if /^1;$/; + } + + # and now get the current version::vpp code + my $vpp; + while (<DATA>) { + s/(\$VERSION)\s=\s\d+/\$VERSION = 0/; + $vpp .= $_ if $_; + last if /^1;$/; + } + + # but we eval them in reverse order since version depends on + # version::vpp to already exist + eval $vpp; + $INC{'version/vpp.pm'} = 'inside Module::Build::Version'; + eval $version; + $INC{'version.pm'} = 'inside Module::Build::Version'; +} + +# now we can safely subclass version, installed or not +use vars qw(@ISA); +@ISA = qw(version); use overload ( '""' => \&stringify, @@ -24,3 +58,475 @@ sub stringify { } 1; +__DATA__ +# stub version module to make everything else happy +package version; + +use 5.005_04; +use strict; + +use vars qw(@ISA $VERSION $CLASS *qv); + +$VERSION = 0.000; + +$CLASS = 'version'; + +push @ISA, "version::vpp"; +*version::qv = \&version::vpp::qv; + +# Preloaded methods go here. +sub import { + my ($class) = @_; + my $callpkg = caller(); + no strict 'refs'; + + *{$callpkg."::qv"} = + sub {return bless version::qv(shift), $class } + unless defined(&{"$callpkg\::qv"}); + +} + +1; +# replace everything from here to the end with the current version/vpp.pm + +package version::vpp; +use strict; + +use Scalar::Util; +use vars qw ($VERSION @ISA @REGEXS); +$VERSION = 0.661; + +push @REGEXS, qr/ + ^v? # optional leading 'v' + (\d*) # major revision not required + \. # requires at least one decimal + (?:(\d+)\.?){1,} + /x; + +use overload ( + '""' => \&stringify, + 'cmp' => \&vcmp, + '<=>' => \&vcmp, +); + +sub new +{ + my ($class, $value) = @_; + my $self = bless ({}, ref ($class) || $class); + + if ( not defined $value or $value =~ /^undef$/ ) { + # RT #19517 - special case for undef comparison + # or someone forgot to pass a value + push @{$self->{version}}, 0; + return ($self); + } + + if ( $#_ == 2 ) { # must be CVS-style + $value = 'v'.$_[2]; + } + + # may be a v-string + if ( $] >= 5.006_002 && length($value) >= 3 && $value !~ /[._]/ ) { + my $tvalue = sprintf("%vd",$value); + if ( $tvalue =~ /^\d+\.\d+\.\d+$/ ) { + # must be a v-string + $value = $tvalue; + } + } + + # This is not very efficient, but it is morally equivalent + # to the XS code (as that is the reference implementation). + # See vutil/vutil.c for details + my $qv = 0; + my $alpha = 0; + my $width = 3; + my $saw_period = 0; + my ($start, $last, $pos, $s); + $s = 0; + + while ( substr($value,$s,1) =~ /\s/ ) { # leading whitespace is OK + $s++; + } + + if (substr($value,$s,1) eq 'v') { + $s++; # get past 'v' + $qv = 1; # force quoted version processing + } + + $start = $last = $pos = $s; + + # pre-scan the input string to check for decimals/underbars + while ( substr($value,$pos,1) =~ /[._\d]/ ) { + if ( substr($value,$pos,1) eq '.' ) { + die "Invalid version format (underscores before decimal)" + if $alpha; + $saw_period++; + $last = $pos; + } + elsif ( substr($value,$pos,1) eq '_' ) { + die "Invalid version format (multiple underscores)" + if $alpha; + $alpha = 1; + $width = $pos - $last - 1; # natural width of sub-version + } + $pos++; + } + + if ( $alpha && !$saw_period ) { + die "Invalid version format (alpha without decimal)"; + } + + if ( $saw_period > 1 ) { + $qv = 1; # force quoted version processing + } + + $pos = $s; + + if ( $qv ) { + $self->{qv} = 1; + } + + if ( $alpha ) { + $self->{alpha} = 1; + } + + if ( !$qv && $width < 3 ) { + $self->{width} = $width; + } + + while ( substr($value,$pos,1) =~ /\d/ ) { + $pos++; + } + + if ( substr($value,$pos,1) !~ /[a-z]/ ) { ### FIX THIS ### + my $rev; + + while (1) { + $rev = 0; + { + + # this is atoi() that delimits on underscores + my $end = $pos; + my $mult = 1; + my $orev; + + # the following if() will only be true after the decimal + # point of a version originally created with a bare + # floating point number, i.e. not quoted in any way + if ( !$qv && $s > $start && $saw_period == 1 ) { + $mult *= 100; + while ( $s < $end ) { + $orev = $rev; + $rev += substr($value,$s,1) * $mult; + $mult /= 10; + if ( abs($orev) > abs($rev) ) { + die "Integer overflow in version"; + } + $s++; + if ( substr($value,$s,1) eq '_' ) { + $s++; + } + } + } + else { + while (--$end >= $s) { + $orev = $rev; + $rev += substr($value,$end,1) * $mult; + $mult *= 10; + if ( abs($orev) > abs($rev) ) { + die "Integer overflow in version"; + } + } + } + } + + # Append revision + push @{$self->{version}}, $rev; + if ( substr($value,$pos,1) eq '.' + && substr($value,$pos+1,1) =~ /\d/ ) { + $s = ++$pos; + } + elsif ( substr($value,$pos,1) eq '_' + && substr($value,$pos+1,1) =~ /\d/ ) { + $s = ++$pos; + } + elsif ( substr($value,$pos,1) =~ /\d/ ) { + $s = $pos; + } + else { + $s = $pos; + last; + } + if ( $qv ) { + while ( substr($value,$pos,1) =~ /\d/ ) { + $pos++; + } + } + else { + my $digits = 0; + while (substr($value,$pos,1) =~ /[\d_]/ && $digits < 3) { + if ( substr($value,$pos,1) ne '_' ) { + $digits++; + } + $pos++; + } + } + } + } + if ( $qv ) { # quoted versions always get at least three terms + my $len = scalar @{$self->{version}}; + $len = 3 - $len; + while ($len-- > 0) { + push @{$self->{version}}, 0; + } + } + + if ( substr($value,$pos) ) { # any remaining text + warn "Version string '$value' contains invalid data; ". + "ignoring: '".substr($value,$pos)."'"; + } + + return ($self); +} + +sub numify +{ + my ($self) = @_; + unless (_verify($self)) { + die "Invalid version object"; + } + my $width = $self->{width} || 3; + my $alpha = $self->{alpha} || ""; + my $len = $#{$self->{version}}; + my $digit = $self->{version}[0]; + my $string = sprintf("%d.", $digit ); + + for ( my $i = 1 ; $i < $len ; $i++ ) { + $digit = $self->{version}[$i]; + if ( $width < 3 ) { + my $denom = 10**(3-$width); + my $quot = int($digit/$denom); + my $rem = $digit - ($quot * $denom); + $string .= sprintf("%0".$width."d_%d", $quot, $rem); + } + else { + $string .= sprintf("%03d", $digit); + } + } + + if ( $len > 0 ) { + $digit = $self->{version}[$len]; + if ( $alpha && $width == 3 ) { + $string .= "_"; + } + $string .= sprintf("%0".$width."d", $digit); + } + else # $len = 0 + { + $string .= sprintf("000"); + } + + return $string; +} + +sub normal +{ + my ($self) = @_; + unless (_verify($self)) { + die "Invalid version object"; + } + my $alpha = $self->{alpha} || ""; + my $len = $#{$self->{version}}; + my $digit = $self->{version}[0]; + my $string = sprintf("v%d", $digit ); + + for ( my $i = 1 ; $i < $len ; $i++ ) { + $digit = $self->{version}[$i]; + $string .= sprintf(".%d", $digit); + } + + if ( $len > 0 ) { + $digit = $self->{version}[$len]; + if ( $alpha ) { + $string .= sprintf("_%0d", $digit); + } + else { + $string .= sprintf(".%0d", $digit); + } + } + + if ( $len <= 2 ) { + for ( $len = 2 - $len; $len != 0; $len-- ) { + $string .= sprintf(".%0d", 0); + } + } + + return $string; +} + +sub stringify +{ + my ($self) = @_; + unless (_verify($self)) { + die "Invalid version object"; + } + if ( exists $self->{qv} ) { + return $self->normal; + } + else { + return $self->numify; + } +} + +sub vcmp +{ + require UNIVERSAL; + my ($left,$right,$swap) = @_; + my $class = ref($left); + unless ( UNIVERSAL::isa($right, $class) ) { + $right = $class->new($right); + } + + if ( $swap ) { + ($left, $right) = ($right, $left); + } + unless (_verify($left)) { + die "Invalid version object"; + } + unless (_verify($right)) { + die "Invalid version object"; + } + my $l = $#{$left->{version}}; + my $r = $#{$right->{version}}; + my $m = $l < $r ? $l : $r; + my $lalpha = $left->is_alpha; + my $ralpha = $right->is_alpha; + my $retval = 0; + my $i = 0; + while ( $i <= $m && $retval == 0 ) { + $retval = $left->{version}[$i] <=> $right->{version}[$i]; + $i++; + } + + # tiebreaker for alpha with identical terms + if ( $retval == 0 + && $l == $r + && $left->{version}[$m] == $right->{version}[$m] + && ( $lalpha || $ralpha ) ) { + + if ( $lalpha && !$ralpha ) { + $retval = -1; + } + elsif ( $ralpha && !$lalpha) { + $retval = +1; + } + } + + # possible match except for trailing 0's + if ( $retval == 0 && $l != $r ) { + if ( $l < $r ) { + while ( $i <= $r && $retval == 0 ) { + if ( $right->{version}[$i] != 0 ) { + $retval = -1; # not a match after all + } + $i++; + } + } + else { + while ( $i <= $l && $retval == 0 ) { + if ( $left->{version}[$i] != 0 ) { + $retval = +1; # not a match after all + } + $i++; + } + } + } + + return $retval; +} + +sub is_alpha { + my ($self) = @_; + return (exists $self->{alpha}); +} + +sub qv { + my ($value) = @_; + + if ( $value =~ /\d+e-?\d+/ ) { # exponential notation + $value = sprintf("%.9f",$value); + $value =~ s/(0+)//; + } + + my $eval = eval 'Scalar::Util::isvstring($value)'; + if ( !$@ and $eval ) { + $value = sprintf("v%vd",$value); + } + else { + $value = 'v'.$value unless $value =~ /^v/; + } + return version->new($value); # always use base class +} + +sub _verify { + my ($self) = @_; + if ( Scalar::Util::reftype($self) eq 'HASH' + && exists $self->{version} + && ref($self->{version}) eq 'ARRAY' + ) { + return 1; + } + else { + return 0; + } +} + +# Thanks to Yitzchak Scott-Thoennes for this mode of operation +{ + local $^W; + *UNIVERSAL::VERSION = sub { + my ($obj, $req) = @_; + my $class = ref($obj) || $obj; + + no strict 'refs'; + eval "require $class" unless %{"$class\::"}; # already existing + die "$class defines neither package nor VERSION--version check failed" + if $@ or not %{"$class\::"}; + + my $version = eval "\$$class\::VERSION"; + if ( defined $version ) { + $version = version::vpp->new($version); + } + + if ( defined $req ) { + if ( $req =~ /\d+e-?\d+/ ) { # exponential notation + $req = sprintf("%.9f",$req); + $req =~ s/(0+)$//; + } + unless ( defined $version ) { + my $msg = "$class does not define ". + "\$$class\::VERSION--version check failed"; + if ( $ENV{VERSION_DEBUG} ) { + require Carp; + Carp::confess($msg); + } + else { + die($msg); + } + } + + $req = version::vpp->new($req); + + if ( $req > $version ) { + die sprintf ("%s version %s (%s) required--". + "this is only version %s (%s)", $class, + $req->numify, $req->normal, + $version->numify, $version->normal); + } + } + + return defined $version ? $version->numify : undef; + }; +} + +1; #this line is important and will help the module return a true value diff --git a/lib/Module/Build/t/moduleinfo.t b/lib/Module/Build/t/moduleinfo.t index b056d1375a..1c2233f528 100644 --- a/lib/Module/Build/t/moduleinfo.t +++ b/lib/Module/Build/t/moduleinfo.t @@ -2,7 +2,7 @@ use strict; use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib'; -use MBTest tests => 72; +use MBTest tests => 75; use Cwd (); my $cwd = Cwd::cwd; @@ -187,7 +187,8 @@ foreach my $module ( @modules ) { local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; my $pm_info = Module::Build::ModuleInfo->new_from_file( $file ); - cmp_ok( $pm_info->version, '==', '1.23', + # Test::Builder will prematurely numify objects, so use this form + ok( $pm_info->version eq '1.23', "correct module version ($i of $n)" ); is( $warnings, '', 'no warnings from parsing' ); $i++; @@ -345,7 +346,6 @@ $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 @@ -385,8 +385,28 @@ if ( $name ) { is( $name, q|Simple - It's easy.|, 'collected pod section' ); +{ + # examine properties of a module: name, pod, etc + $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']); +} + + # cleanup -chdir( $cwd ) or die "Can''t chdir to '$cwd': $!"; +chdir( $cwd ) or die "Can't chdir to '$cwd': $!"; $dist->remove; use File::Path; |