[svn:Module-Build] r12913 - in Module-Build/trunk: . lib/Module/Build t

[email protected]
Newsgroups perl.module.build.checkins
Message-ID <[email protected]>
Author: dagolden
Date: Fri Jun 26 04:05:00 2009
New Revision: 12913

Modified:
   Module-Build/trunk/Changes
   Module-Build/trunk/lib/Module/Build/Base.pm
   Module-Build/trunk/lib/Module/Build/Version.pm
   Module-Build/trunk/t/metadata.t

Log:
update M::B::Version for upcoming version.pm 0.77

Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes	(original)
+++ Module-Build/trunk/Changes	Fri Jun 26 04:05:00 2009
@@ -3,12 +3,13 @@
 0.33_04 - 
 
  Bug-fixes:
- - Don't try utf8 YAML I/O on Perl 5.6
+ - Don't try utf8 YAML I/O on Perl 5.6 [David Golden]
 
  Other
  - skips xs.t and ppm.t when perl was not compiled with dynamic loading
    since Module::Buld does not support static linking (RT#46178) 
    [David Golden]
+ - skip failing test in par.t if Archive::Zip is broken [David Golden]
  - Added YAML utf8 patch in 0.33_03 changes list
  - Added attribution for patches in 0.33_03 changes list
 

Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm	(original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm	Fri Jun 26 04:05:00 2009
@@ -3639,9 +3639,7 @@
   }
   elsif ( ref $version eq 'version' || 
           ref $version eq 'Module::Build::Version' ) { # version objects
-    my $string = $version->stringify;
-    # normalize leading-v: "v1.2" -> "v1.2.0"
-    $version = substr($string,0,1) eq 'v' ? $version->normal : $string;
+    $version = $version->is_qv ? $version->normal : $version->stringify;
   }
   elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
     # normalize string tuples without "v": "1.2.3" -> "v1.2.3"

Modified: Module-Build/trunk/lib/Module/Build/Version.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Version.pm	(original)
+++ Module-Build/trunk/lib/Module/Build/Version.pm	Fri Jun 26 04:05:00 2009
@@ -2,7 +2,7 @@
 use strict;
 
 use vars qw($VERSION);
-$VERSION = 0.74;
+$VERSION = 0.77;
 
 eval "use version $VERSION";
 if ($@) { # can't locate version files, use our own
@@ -46,35 +46,81 @@
 use 5.005_04;
 use strict;
 
-use vars qw(@ISA $VERSION $CLASS *qv);
+use vars qw(@ISA $VERSION $CLASS *declare *qv);
 
-$VERSION = 0.000;
+$VERSION = 0;
 
 $CLASS = 'version';
 
 push @ISA, "version::vpp";
+local $^W;
 *version::qv = \&version::vpp::qv;
+*version::declare = \&version::vpp::declare;
+*version::_VERSION = \&version::vpp::_VERSION;
+if ($] > 5.009001 && $] <= 5.010000) {
+    no strict 'refs';
+    *{'version::stringify'} = \*version::vpp::stringify;
+    *{'version::(""'} = \*version::vpp::stringify;
+}
 
 # Preloaded methods go here.
 sub import {
-    my ($class) = @_;
-    my $callpkg = caller();
     no strict 'refs';
+    my ($class) = shift;
+
+    # Set up any derived class
+    unless ($class eq 'version') {
+	local $^W;
+	*{$class.'::declare'} =  \&version::declare;
+	*{$class.'::qv'} = \&version::qv;
+    }
+
+    my %args;
+    if (@_) { # any remaining terms are arguments
+	map { $args{$_} = 1 } @_
+    }
+    else { # no parameters at all on use line
+    	%args = 
+	(
+	    qv => 1,
+	    'UNIVERSAL::VERSION' => 1,
+	);
+    }
+
+    my $callpkg = caller();
     
-    *{$callpkg."::qv"} = 
-	    sub {return bless version::qv(shift), $class }
-	unless defined(&{"$callpkg\::qv"});
+    if (exists($args{declare})) {
+	*{$callpkg."::declare"} = 
+	    sub {return $class->declare(shift) }
+	  unless defined(&{$callpkg.'::declare'});
+    }
 
+    if (exists($args{qv})) {
+	*{$callpkg."::qv"} =
+	    sub {return $class->qv(shift) }
+	  unless defined(&{"$callpkg\::qv"});
+    }
+
+    if (exists($args{'UNIVERSAL::VERSION'})) {
+	local $^W;
+	*UNIVERSAL::VERSION = \&version::_VERSION;
+    }
+
+    if (exists($args{'VERSION'})) {
+	*{$callpkg."::VERSION"} = \&version::_VERSION;
+    }
 }
 
 1;
+
 # replace everything from here to the end with the current version/vpp.pm
 package version::vpp;
 use strict;
 
+use POSIX qw/locale_h/;
 use locale;
 use vars qw ($VERSION @ISA @REGEXS);
-$VERSION = 0.76;
+$VERSION = '0.77';
 
 push @REGEXS, qr/
 	^v?	# optional leading 'v'
@@ -108,7 +154,7 @@
 	my ($class, $value) = @_;
 	my $self = bless ({}, ref ($class) || $class);
 	
-	if ( ref($value) && eval("$value->isa('version')") ) {
+	if ( ref($value) && eval('$value->isa("version")') ) {
 	    # Can copy the elements directly
 	    $self->{version} = [ @{$value->{version} } ];
 	    $self->{qv} = 1 if $value->{qv};
@@ -117,9 +163,14 @@
 	    return $self;
 	}
 
-	require POSIX;
-	my $currlocale = POSIX::setlocale(&POSIX::LC_ALL);
-	my $radix_comma = ( POSIX::localeconv()->{decimal_point} eq ',' );
+	my $currlocale = setlocale(LC_ALL);
+
+	# if the current locale uses commas for decimal points, we
+	# just replace commas with decimal places, rather than changing
+	# locales
+	if ( localeconv()->{decimal_point} eq ',' ) {
+	    $value =~ tr/,/./;
+	}
 
 	if ( not defined $value or $value =~ /^undef$/ ) {
 	    # RT #19517 - special case for undef comparison
@@ -136,18 +187,11 @@
 	$value = _un_vstring($value);
 
 	# exponential notation
-	if ( $value =~ /\d+.?\d*e-?\d+/ ) {
+	if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) {
 	    $value = sprintf("%.9f",$value);
-	    $value =~ s/(0+)$//;
+	    $value =~ s/(0+)$//; # trim trailing zeros
 	}
 	
-	# if the original locale used commas for decimal points, we
-	# just replace commas with decimal places, rather than changing
-	# locales
-	if ( $radix_comma ) {
-	    $value =~ tr/,/./;
-	}
-
 	# 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
@@ -171,7 +215,7 @@
 	$start = $last = $pos = $s;
 		
 	# pre-scan the input string to check for decimals/underbars
-	while ( substr($value,$pos,1) =~ /[._\d]/ ) {
+	while ( substr($value,$pos,1) =~ /[._\d,]/ ) {
 	    if ( substr($value,$pos,1) eq '.' ) {
 		if ($alpha) {
 		    Carp::croak("Invalid version format ".
@@ -189,6 +233,12 @@
 		$alpha = 1;
 		$width = $pos - $last - 1; # natural width of sub-version
 	    }
+	    elsif ( substr($value,$pos,1) eq ','
+		    and substr($value,$pos+1,1) =~ /[0-9]/ ) {
+		# looks like an unhandled locale
+		$saw_period++;
+		$last = $pos;
+	    }
 	    $pos++;
 	}
 
@@ -291,6 +341,10 @@
 		    && 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;
 		}
@@ -342,6 +396,8 @@
 	return ($self);
 }
 
+*parse = \&new;
+
 sub numify 
 {
     my ($self) = @_;
@@ -518,14 +574,21 @@
 }
 
 sub qv {
-    my ($value) = @_;
+    my $value = shift;
+    my $class = 'version';
+    if (@_) {
+	$class = ref($value) || $value;
+	$value = shift;
+    }
 
     $value = _un_vstring($value);
     $value = 'v'.$value unless $value =~ /(^v|\d+\.\d+\.\d)/;
-    my $version = version->new($value); # always use base class
+    my $version = $class->new($value);
     return $version;
 }
 
+*declare = \&qv;
+
 sub is_qv {
     my ($self) = @_;
     return (exists $self->{qv});
@@ -558,69 +621,64 @@
     return $value;
 }
 
-# Thanks to Yitzchak Scott-Thoennes for this mode of operation
-{
-    local $^W;
-    *UNIVERSAL::VERSION # Module::Build::ModuleInfo doesn't see this now
-      = sub {
-	my ($obj, $req) = @_;
-	my $class = ref($obj) || $obj;
-
-	no strict 'refs';
-	eval "require $class" unless %{"$class\::"}; # already existing
-	return undef if $@ =~ /Can't locate/ and not defined $req;
-	
-	if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
-	    require Carp;
-	    Carp::croak( "$class defines neither package nor VERSION"
-		."--version check failed");
-	}
-	
-	my $version = eval "\$$class\::VERSION";
-	if ( defined $version ) {
-	    local $^W if $] <= 5.008;
-	    $version = version::vpp->new($version);
-	}
+sub _VERSION {
+    my ($obj, $req) = @_;
+    my $class = ref($obj) || $obj;
 
-	if ( defined $req ) {
-	    unless ( defined $version ) {
-		require Carp;
-		my $msg =  $] < 5.006 
-		? "$class version $req required--this is only version "
-		: "$class does not define \$$class\::VERSION"
-		  ."--version check failed";
+    no strict 'refs';
+    eval "require $class" unless %{"$class\::"}; # already existing
+    return undef if $@ =~ /Can't locate/ and not defined $req;
+    
+    if ( not %{"$class\::"} and $] >= 5.008) { # file but no package
+	require Carp;
+	Carp::croak( "$class defines neither package nor VERSION"
+	    ."--version check failed");
+    }
+    
+    my $version = eval "\$$class\::VERSION";
+    if ( defined $version ) {
+	local $^W if $] <= 5.008;
+	$version = version::vpp->new($version);
+    }
 
-		if ( $ENV{VERSION_DEBUG} ) {
-		    Carp::confess($msg);
-		}
-		else {
-		    Carp::croak($msg);
-		}
+    if ( defined $req ) {
+	unless ( defined $version ) {
+	    require Carp;
+	    my $msg =  $] < 5.006 
+	    ? "$class version $req required--this is only version "
+	    : "$class does not define \$$class\::VERSION"
+	      ."--version check failed";
+
+	    if ( $ENV{VERSION_DEBUG} ) {
+		Carp::confess($msg);
 	    }
+	    else {
+		Carp::croak($msg);
+	    }
+	}
 
-	    $req = version::vpp->new($req);
+	$req = version::vpp->new($req);
 
-	    if ( $req > $version ) {
-		require Carp;
-		if ( $req->is_qv ) {
-		    Carp::croak( 
-			sprintf ("%s version %s required--".
-			    "this is only version %s", $class,
-			    $req->normal, $version->normal)
-		    );
-		}
-		else {
-		    Carp::croak( 
-			sprintf ("%s version %s required--".
-			    "this is only version %s", $class,
-			    $req->stringify, $version->stringify)
-		    );
-		}
+	if ( $req > $version ) {
+	    require Carp;
+	    if ( $req->is_qv ) {
+		Carp::croak( 
+		    sprintf ("%s version %s required--".
+			"this is only version %s", $class,
+			$req->normal, $version->normal)
+		);
+	    }
+	    else {
+		Carp::croak( 
+		    sprintf ("%s version %s required--".
+			"this is only version %s", $class,
+			$req->stringify, $version->stringify)
+		);
 	    }
 	}
+    }
 
-	return defined $version ? $version->stringify : undef;
-    };
+    return defined $version ? $version->stringify : undef;
 }
 
 1; #this line is important and will help the module return a true value

Modified: Module-Build/trunk/t/metadata.t
==============================================================================
--- Module-Build/trunk/t/metadata.t	(original)
+++ Module-Build/trunk/t/metadata.t	Fri Jun 26 04:05:00 2009
@@ -168,8 +168,8 @@
 ---
   $dist->regen;
   my $provides = new_build()->prepare_metadata()->{provides};
-  is $provides->{'Simple'}{version}, '0.60.128', "Check version";
-  is $provides->{'Simple::Simon'}{version}, '0.61.129', "Check version";
+  is $provides->{'Simple'}{version}, 'v0.60.128', "Check version";
+  is $provides->{'Simple::Simon'}{version}, 'v0.61.129', "Check version";
   is ref($provides->{'Simple'}{version}), '', "Versions from prepare_metadata() aren't refs";
   is ref($provides->{'Simple::Simon'}{version}), '', "Versions from prepare_metadata() aren't refs";
 }
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.