From: David Golden Date: Fri, 10 Dec 2010 14:20:10 +0000 (-0500) Subject: switch from Module::Metadata::Version to version.pm X-Git-Tag: release_1.0.2~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4850170cc2e0c6bd6e9e1381da5be4b6b6b079c2;p=p5sagit%2FModule-Metadata.git switch from Module::Metadata::Version to version.pm --- diff --git a/Makefile.PL b/Makefile.PL index 6f7be25..9686e28 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -6,5 +6,8 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Module::Metadata', - VERSION_FROM => 'lib/Module/Metadata.pm' + VERSION_FROM => 'lib/Module/Metadata.pm', + PREREQ_PM => { + 'version' => 0.87, + }, ); diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm index 99cee97..f292114 100644 --- a/lib/Module/Metadata.pm +++ b/lib/Module/Metadata.pm @@ -16,7 +16,7 @@ $VERSION = eval $VERSION; use File::Spec; use IO::File; -use Module::Metadata::Version; +use version 0.87; BEGIN { if ($INC{'Log/Contextual.pm'}) { Log::Contextual->import('log_info'); @@ -84,8 +84,8 @@ sub new_from_module { my $compare_versions = sub { my ($v1, $op, $v2) = @_; - $v1 = Module::Metadata::Version->new($v1) - unless UNIVERSAL::isa($v1,'Module::Metadata::Version'); + $v1 = version->new($v1) + unless UNIVERSAL::isa($v1,'version'); my $eval_str = "\$v1 $op \$v2"; my $result = eval $eval_str; @@ -99,8 +99,7 @@ sub new_from_module { if ( $version =~ /[=<>!,]/ ) { # logic, not just version # take as is without modification } - elsif ( ref $version eq 'version' || - ref $version eq 'Module::Metadata::Version' ) { # version objects + elsif ( ref $version eq 'version' ) { # version objects $version = $version->is_qv ? $version->normal : $version->stringify; } elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots @@ -515,7 +514,7 @@ sub _evaluate_version_line { $pn++; # everybody gets their own package my $eval = qq{BEGIN { q# Hide from _packages_inside() #; package Module::Metadata::_version::p$pn; - use Module::Metadata::Version; + use version; no strict; local $sigil$var; @@ -553,7 +552,7 @@ sub _evaluate_version_line { } # Bless it into our own version class - eval { $result = Module::Metadata::Version->new($result) }; + eval { $result = version->new($result) }; die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" if $@; diff --git a/lib/Module/Metadata/Version.pm b/lib/Module/Metadata/Version.pm deleted file mode 100644 index d72a51a..0000000 --- a/lib/Module/Metadata/Version.pm +++ /dev/null @@ -1,719 +0,0 @@ -package Module::Metadata::Version; -use strict; - -# stolen from Module::Build::Version - this is perl licensed code, -# copyright them. - -use vars qw($VERSION); -$VERSION = 0.77; - -eval "use version $VERSION"; -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 () { - s/(\$VERSION)\s=\s\d+/\$VERSION = 0/; - $version .= $_ if $_; - last if /^1;$/; - } - - # and now get the current version::vpp code - my $vpp; - while () { - 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; die $@ if $@; - $INC{'version/vpp.pm'} = 'inside Module::Metadata::Version'; - eval $version; die $@ if $@; - $INC{'version.pm'} = 'inside Module::Metadata::Version'; -} - -# now we can safely subclass version, installed or not -use vars qw(@ISA); -@ISA = qw(version); - -1; - -=head1 NAME - -Module::Metadata::Version - inlined version.pm fallback for Module::Metadata - -=head1 DESCRIPTION - -This module either loads version.pm if available, or if not slurps its own -private copy of version::vpp into memory as a fallback, then makes itself -a subclass of whichever it found. - -This is a horrible hack. But so is version.pm. - -=head1 AUTHOR - -Ken Williams , Randy W. Sims - -Documented by Matt S Trout (mst) - -=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. - -=head1 SEE ALSO - -perl(1), L(3) - -=cut - -__DATA__ -# stub version module to make everything else happy -package version; - -use 5.005_04; -use strict; - -use vars qw(@ISA $VERSION $CLASS *declare *qv); - -$VERSION = 0.77; - -$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; - *{'version::new'} = \*version::vpp::new; -} - -# Preloaded methods go here. -sub import { - 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(); - - 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.77'; -$VERSION = eval $VERSION; - -push @REGEXS, qr/ - ^v? # optional leading 'v' - (\d*) # major revision not required - \. # requires at least one decimal - (?:(\d+)\.?){1,} - /x; - -use overload ( - '""' => \&stringify, - '0+' => \&numify, - 'cmp' => \&vcmp, - '<=>' => \&vcmp, - 'bool' => \&vbool, - 'nomethod' => \&vnoop, -); - -my $VERSION_MAX = 0x7FFFFFFF; - -eval "use warnings"; -if ($@) { - eval ' - package warnings; - sub enabled {return $^W;} - 1; - '; -} - -sub new -{ - my ($class, $value) = @_; - my $self = bless ({}, ref ($class) || $class); - - if ( ref($value) && eval('$value->isa("version")') ) { - # Can copy the elements directly - $self->{version} = [ @{$value->{version} } ]; - $self->{qv} = 1 if $value->{qv}; - $self->{alpha} = 1 if $value->{alpha}; - $self->{original} = ''.$value->{original}; - return $self; - } - - 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 - # or someone forgot to pass a value - push @{$self->{version}}, 0; - $self->{original} = "0"; - return ($self); - } - - if ( $#_ == 2 ) { # must be CVS-style - $value = 'v'.$_[2]; - } - - $value = _un_vstring($value); - - # exponential notation - if ( $value =~ /\d+.?\d*e[-+]?\d+/ ) { - $value = sprintf("%.9f",$value); - $value =~ s/(0+)$//; # trim trailing zeros - } - - # 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 $vinf = 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 '.' ) { - if ($alpha) { - Carp::croak("Invalid version format ". - "(underscores before decimal)"); - } - $saw_period++; - $last = $pos; - } - elsif ( substr($value,$pos,1) eq '_' ) { - if ($alpha) { - require Carp; - Carp::croak("Invalid version format ". - "(multiple underscores)"); - } - $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++; - } - - if ( $alpha && !$saw_period ) { - require Carp; - Carp::croak("Invalid version format ". - "(alpha without decimal)"); - } - - if ( $alpha && $saw_period && $width == 0 ) { - require Carp; - Carp::croak("Invalid version format ". - "(misplaced _ in number)"); - } - - if ( $saw_period > 1 ) { - $qv = 1; # force quoted version processing - } - - $last = $pos; - $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) - || abs($rev) > abs($VERSION_MAX) ) { - if ( warnings::enabled("overflow") ) { - require Carp; - Carp::carp("Integer overflow in version"); - } - $s = $end - 1; - $rev = $VERSION_MAX; - } - $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) - || abs($rev) > abs($VERSION_MAX) ) { - if ( warnings::enabled("overflow") ) { - require Carp; - Carp::carp("Integer overflow in version"); - } - $end = $s - 1; - $rev = $VERSION_MAX; - } - } - } - } - - # 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) 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 - if ( warnings::enabled("misc") ) { - require Carp; - Carp::carp("Version string '$value' contains invalid data; ". - "ignoring: '".substr($value,$pos)."'"); - } - } - - # cache the original value for use when stringification - if ( $vinf ) { - $self->{vinf} = 1; - $self->{original} = 'v.Inf'; - } - else { - $self->{original} = substr($value,0,$pos); - } - - return ($self); -} - -*parse = \&new; - -sub numify -{ - my ($self) = @_; - unless (_verify($self)) { - require Carp; - Carp::croak("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)) { - require Carp; - Carp::croak("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)) { - require Carp; - Carp::croak("Invalid version object"); - } - return exists $self->{original} - ? $self->{original} - : exists $self->{qv} - ? $self->normal - : $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)) { - require Carp; - Carp::croak("Invalid version object"); - } - unless (_verify($right)) { - require Carp; - Carp::croak("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 vbool { - my ($self) = @_; - return vcmp($self,$self->new("0"),1); -} - -sub vnoop { - require Carp; - Carp::croak("operation not supported with version object"); -} - -sub is_alpha { - my ($self) = @_; - return (exists $self->{alpha}); -} - -sub qv { - 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 = $class->new($value); - return $version; -} - -*declare = \&qv; - -sub is_qv { - my ($self) = @_; - return (exists $self->{qv}); -} - - -sub _verify { - my ($self) = @_; - if ( ref($self) - && eval { exists $self->{version} } - && ref($self->{version}) eq 'ARRAY' - ) { - return 1; - } - else { - return 0; - } -} - -sub _un_vstring { - my $value = shift; - # may be a v-string - if ( $] >= 5.006_000 && length($value) >= 3 && $value !~ /[._]/ ) { - my $tvalue = sprintf("v%vd",$value); - if ( $tvalue =~ /^v\d+\.\d+\.\d+$/ ) { - # must be a v-string - $value = $tvalue; - } - } - return $value; -} - -sub _VERSION { - my ($obj, $req) = @_; - my $class = ref($obj) || $obj; - - no strict 'refs'; - if ( exists $INC{"$class.pm"} and 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 ( 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); - - 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; -} - -1; #this line is important and will help the module return a true value