X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FModule%2FMetadata.pm;h=6b535b2c58bda4d95dc19b9523c8a8f6d79e399b;hb=92e32892672c3d3d9e6318f0b02a0850acb47797;hp=99cee971c71bc3b5c8d2ce845f8a00e04e0d42b0;hpb=9d50689d146d2ddb32442bce32443d614c336870;p=p5sagit%2FModule-Metadata.git

diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm
index 99cee97..6b535b2 100644
--- a/lib/Module/Metadata.pm
+++ b/lib/Module/Metadata.pm
@@ -2,8 +2,8 @@
 # vim:ts=8:sw=2:et:sta:sts=2
 package Module::Metadata;
 
-# stolen from Module::Build::Version and ::Base - this is perl licensed code,
-# copyright them.
+# Adapted from Perl-licensed code originally distributed with
+# Module-Build by Ken Williams
 
 # This module provides routines to gather information about
 # perl modules (assuming this may be expanded in the distant
@@ -11,12 +11,12 @@ package Module::Metadata;
 
 use strict;
 use vars qw($VERSION);
-$VERSION = '1.000001';
+$VERSION = '1.000005';
 $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,12 +514,12 @@ 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;
-    \$$var=undef;
       \$vsub = sub {
+        local $sigil$var;
+        \$$var=undef;
         $line;
         \$$var
       };
@@ -543,24 +542,72 @@ sub _evaluate_version_line {
   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;
-  }
+  # Upgrade it into a version object
+  my $version = eval { _dwim_version($result) };
 
-  # Bless it into our own version class
-  eval { $result = Module::Metadata::Version->new($result) };
   die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
-    if $@;
+    unless defined $version; # "0" is OK!
 
-  return $result;
+  return $version;
 }
 }
 
+# Try to DWIM when things fail the lax version test in obvious ways
+{
+  my @version_prep = (
+    # Best case, it just works
+    sub { return shift },
+
+    # If we still don't have a version, try stripping any
+    # trailing junk that is prohibited by lax rules
+    sub {
+      my $v = shift;
+      $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
+      return $v;
+    },
+
+    # Activestate apparently creates custom versions like '1.23_45_01', which
+    # cause version.pm to think it's an invalid alpha.  So check for that
+    # and strip them
+    sub {
+      my $v = shift;
+      my $num_dots = () = $v =~ m{(\.)}g;
+      my $num_unders = () = $v =~ m{(_)}g;
+      my $leading_v = substr($v,0,1) eq 'v';
+      if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
+        $v =~ s{_}{}g;
+        $num_unders = () = $v =~ m{(_)}g;
+      }
+      return $v;
+    },
+
+    # Worst case, try numifying it like we would have before version objects
+    sub {
+      my $v = shift;
+      no warnings 'numeric';
+      return 0 + $v;
+    },
+
+  );
+
+  sub _dwim_version {
+    my ($result) = shift;
+
+    return $result if ref($result) eq 'version';
+
+    my ($version, $error);
+    for my $f (@version_prep) {
+      $result = $f->($result);
+      $version = eval { version->new($result) };
+      $error ||= $@ if $@; # capture first failure
+      last if defined $version;
+    }
+
+    die $error unless defined $version;
+
+    return $version;
+  }
+}
 
 ############################################################
 
@@ -700,14 +747,10 @@ assistance from David Golden (xdg) <dagolden@cpan.org>
 
 =head1 COPYRIGHT
 
-Copyright (c) 2001-2006 Ken Williams.  All rights reserved.
+Copyright (c) 2001-2011 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<Module::Build::ModuleInfo>(3)
-
 =cut