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

diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm
index d992477..0b48828 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.000011';
+$VERSION = '1.000013';
 $VERSION = eval $VERSION;
 
 use Carp qw/croak/;
@@ -29,11 +29,39 @@ use File::Find qw(find);
 
 my $V_NUM_REGEXP = qr{v?[0-9._]+};  # crudely, a v-string or decimal
 
+my $PKG_FIRST_WORD_REGEXP = qr{ # the FIRST word in a package name
+  [a-zA-Z_]                     # the first word CANNOT start with a digit
+    (?:
+      [\w']?                    # can contain letters, digits, _, or ticks
+      \w                        # But, NO multi-ticks or trailing ticks
+    )*
+}x;
+
+my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name
+  \w                           # the 2nd+ word CAN start with digits
+    (?:
+      [\w']?                   # and can contain letters or ticks
+      \w                       # But, NO multi-ticks or trailing ticks
+    )*
+}x;
+
+my $PKG_NAME_REGEXP = qr{ # match a package name
+  (?: :: )?               # a pkg name can start with aristotle
+  $PKG_FIRST_WORD_REGEXP  # a package word
+  (?:
+    (?: :: )+             ### aristotle (allow one or many times)
+    $PKG_ADDL_WORD_REGEXP ### a package word
+  )*                      # ^ zero, one or many times
+  (?:
+    ::                    # allow trailing aristotle
+  )?
+}x;
+
 my $PKG_REGEXP  = qr{   # match a package declaration
   ^[\s\{;]*             # intro chars on a line
   package               # the word 'package'
   \s+                   # whitespace
-  ([\w:]+)              # a package name
+  ($PKG_NAME_REGEXP)    # a package name
   \s*                   # optional whitespace
   ($V_NUM_REGEXP)?        # optional version number
   \s*                   # optional whitesapce
@@ -490,6 +518,7 @@ sub _parse_fh {
   my $pkg = 'main';
   my $pod_sect = '';
   my $pod_data = '';
+  my $in_end = 0;
 
   while (defined( my $line = <$fh> )) {
     my $line_num = $.;
@@ -532,11 +561,18 @@ sub _parse_fh {
 
     } else {
 
+      # Skip after __END__
+      next if $in_end;
+
       # 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)__$/;
+      if ($line eq '__END__') {
+        $in_end++;
+        next;
+      }
+      last if $line eq '__DATA__';
 
       # parse $line to see if it's a $VERSION declaration
       my( $vers_sig, $vers_fullname, $vers_pkg ) =
@@ -713,12 +749,12 @@ sub _evaluate_version_line {
 ############################################################
 
 # accessors
-sub name            { $_[0]->{module}           }
+sub name            { $_[0]->{module}            }
 
-sub filename        { $_[0]->{filename}         }
-sub packages_inside { @{$_[0]->{packages}}      }
-sub pod_inside      { @{$_[0]->{pod_headings}}  }
-sub contains_pod    { $#{$_[0]->{pod_headings}} }
+sub filename        { $_[0]->{filename}          }
+sub packages_inside { @{$_[0]->{packages}}       }
+sub pod_inside      { @{$_[0]->{pod_headings}}   }
+sub contains_pod    { 0+@{$_[0]->{pod_headings}} }
 
 sub version {
     my $self = shift;
@@ -934,7 +970,10 @@ Returns the absolute path to the file.
 Returns a list of packages. Note: this is a raw list of packages
 discovered (or assumed, in the case of C<main>).  It is not
 filtered for C<DB>, C<main> or private packages the way the
-C<provides> method does.
+C<provides> method does.  Invalid package names are not returned,
+for example "Foo:Bar".  Strange but valid package names are
+returned, for example "Foo::Bar::", and are left up to the caller
+on how to handle.
 
 =item C<< pod_inside() >>