X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FModule%2FMetadata.pm;h=d9924777bc59457cad92978b795c2291383ff169;hb=dd5a4b10a5e1a7e13fc31c6001ebb21628642c6a;hp=10c8e68acc5bf27dc7ef071b3906a14c9ffd21d0;hpb=a88210e4638148305f1ea34b22b4561642627d90;p=p5sagit%2FModule-Metadata.git

diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm
index 10c8e68..d992477 100644
--- a/lib/Module/Metadata.pm
+++ b/lib/Module/Metadata.pm
@@ -11,7 +11,7 @@ package Module::Metadata;
 
 use strict;
 use vars qw($VERSION);
-$VERSION = '1.000010';
+$VERSION = '1.000011';
 $VERSION = eval $VERSION;
 
 use Carp qw/croak/;
@@ -61,7 +61,6 @@ my $VERS_REGEXP = qr{ # match a VERSION definition
   =[^=~]  # = but not ==, nor =~
 }x;
 
-
 sub new_from_file {
   my $class    = shift;
   my $filename = File::Spec->rel2abs( shift );
@@ -94,16 +93,16 @@ sub new_from_module {
 }
 
 {
-  
+
   my $compare_versions = sub {
     my ($v1, $op, $v2) = @_;
     $v1 = version->new($v1)
       unless UNIVERSAL::isa($v1,'version');
-  
+
     my $eval_str = "\$v1 $op \$v2";
     my $result   = eval $eval_str;
     log_info { "error comparing versions: '$eval_str' $@" } if $@;
-  
+
     return $result;
   };
 
@@ -129,7 +128,7 @@ sub new_from_module {
 
   my $resolve_module_versions = sub {
     my $packages = shift;
-  
+
     my( $file, $version );
     my $err = '';
       foreach my $p ( @$packages ) {
@@ -147,17 +146,17 @@ sub new_from_module {
         }
         $file ||= $p->{file} if defined( $p->{file} );
       }
-  
+
     if ( $err ) {
       $err = "  $file ($version)\n" . $err;
     }
-  
+
     my %result = (
       file    => $file,
       version => $version,
       err     => $err
     );
-  
+
     return \%result;
   };
 
@@ -222,16 +221,16 @@ sub new_from_module {
       my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir );
       my @path = split( /\//, $mapped_filename );
       (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
-  
+
       my $pm_info = $class->new_from_file( $file );
-  
+
       foreach my $package ( $pm_info->packages_inside ) {
         next if $package eq 'main';  # main can appear numerous times, ignore
         next if $package eq 'DB';    # special debugging package, ignore
         next if grep /^_/, split( /::/, $package ); # private package, ignore
-  
+
         my $version = $pm_info->version( $package );
-  
+
         $prime_package = $package if lc($prime_package) eq lc($package);
         if ( $package eq $prime_package ) {
           if ( exists( $prime{$package} ) ) {
@@ -249,15 +248,15 @@ sub new_from_module {
         }
       }
     }
-  
+
     # Then we iterate over all the packages found above, identifying conflicts
     # and selecting the "best" candidate for recording the file & version
     # for each package.
     foreach my $package ( keys( %alt ) ) {
       my $result = $resolve_module_versions->( $alt{$package} );
-  
+
       if ( exists( $prime{$package} ) ) { # primary package selected
-  
+
         if ( $result->{err} ) {
   	# Use the selected primary package, but there are conflicting
   	# errors among multiple alternative packages that need to be
@@ -267,11 +266,11 @@ sub new_from_module {
   	    "  $prime{$package}{file} ($prime{$package}{version})\n" .
   	    $result->{err}
           };
-  
+
         } elsif ( defined( $result->{version} ) ) {
   	# There is a primary package selected, and exactly one
   	# alternative package
-  
+
   	if ( exists( $prime{$package}{version} ) &&
   	     defined( $prime{$package}{version} ) ) {
   	  # Unless the version of the primary package agrees with the
@@ -287,28 +286,28 @@ sub new_from_module {
   	      "  $result->{file} ($result->{version})\n"
             };
   	  }
-  
+
   	} else {
   	  # The prime package selected has no version so, we choose to
   	  # use any alternative package that does have a version
   	  $prime{$package}{file}    = $result->{file};
   	  $prime{$package}{version} = $result->{version};
   	}
-  
+
         } else {
   	# no alt package found with a version, but we have a prime
   	# package so we use it whether it has a version or not
         }
-  
+
       } else { # No primary package was selected, use the best alternative
-  
+
         if ( $result->{err} ) {
           log_info {
             "Found conflicting versions for package '$package'\n" .
   	    $result->{err}
           };
         }
-  
+
         # Despite possible conflicting versions, we choose to record
         # something rather than nothing
         $prime{$package}{file}    = $result->{file};
@@ -316,17 +315,17 @@ sub new_from_module {
   	  if defined( $result->{version} );
       }
     }
-  
+
     # Normalize versions.  Can't use exists() here because of bug in YAML::Node.
     # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
     for (grep defined $_->{version}, values %prime) {
       $_->{version} = $normalize_version->( $_->{version} );
     }
-  
+
     return \%prime;
   }
-} 
-  
+}
+
 
 sub _init {
   my $class    = shift;
@@ -497,18 +496,20 @@ sub _parse_fh {
 
     chomp( $line );
 
+    # From toke.c : any line that begins by "=X", where X is an alphabetic
+    # character, introduces a POD segment.
     my $is_cut;
-    if ( $line =~ /^=(.{0,3})/ ) {
-      $is_cut = $1 eq 'cut';
+    if ( $line =~ /^=([a-zA-Z].*)/ ) {
+      my $cmd = $1;
+      # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic
+      # character (which includes the newline, but here we chomped it away).
+      $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/;
       $in_pod = !$is_cut;
     }
 
-    # Would be nice if we could also check $in_string or something too
-    last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
-
     if ( $in_pod ) {
 
-      if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
+      if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) {
 	push( @pod, $1 );
 	if ( $self->{collect_pod} && length( $pod_data ) ) {
           $pod{$pod_sect} = $pod_data;
@@ -534,6 +535,9 @@ sub _parse_fh {
       # Skip comments in code
       next if $line =~ /^\s*#/;
 
+      # Would be nice if we could also check $in_string or something too
+      last if $line =~ /^__(?:DATA|END)__$/;
+
       # parse $line to see if it's a $VERSION declaration
       my( $vers_sig, $vers_fullname, $vers_pkg ) =
           ($line =~ /VERSION/)
@@ -554,14 +558,6 @@ sub _parse_fh {
 	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
@@ -587,11 +583,6 @@ EOM
 
 	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
 	}
 
       }