X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FModule%2FMetadata.pm;h=069abb44ea80b57ac59cb03145ca8e239e4b1d5e;hb=ff5475325a5d499e010afeea7315fe1d0bd58ba3;hp=d9924777bc59457cad92978b795c2291383ff169;hpb=dd5a4b10a5e1a7e13fc31c6001ebb21628642c6a;p=p5sagit%2FModule-Metadata.git diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm index d992477..069abb4 100644 --- a/lib/Module/Metadata.pm +++ b/lib/Module/Metadata.pm @@ -10,8 +10,9 @@ package Module::Metadata; # parrot future to look at other types of modules). use strict; -use vars qw($VERSION); -$VERSION = '1.000011'; +use warnings; + +our $VERSION = '1.000019'; $VERSION = eval $VERSION; use Carp qw/croak/; @@ -29,11 +30,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 @@ -58,7 +87,7 @@ my $VERS_REGEXP = qr{ # match a VERSION definition $VARNAME_REGEXP # without parens ) \s* - =[^=~] # = but not ==, nor =~ + =[^=~>] # = but not ==, nor =~, nor => }x; sub new_from_file { @@ -317,7 +346,7 @@ sub new_from_module { } # 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 + # XXX "bug in YAML::Node" comment seems irrelevant -- dagolden, 2009-05-18 for (grep defined $_->{version}, values %prime) { $_->{version} = $normalize_version->( $_->{version} ); } @@ -490,6 +519,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 +562,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 ) = @@ -613,10 +650,11 @@ sub _evaluate_version_line { # compiletime/runtime issues with local() my $vsub; $pn++; # everybody gets their own package - my $eval = qq{BEGIN { q# Hide from _packages_inside() + my $eval = qq{BEGIN { my \$dummy = q# Hide from _packages_inside() #; package Module::Metadata::_version::p$pn; use version; no strict; + no warnings; \$vsub = sub { local $sigil$var; @@ -626,6 +664,8 @@ sub _evaluate_version_line { }; }}; + $eval = $1 if $eval =~ m{^(.+)}s; + local $^W; # Try to get the $VERSION eval $eval; @@ -713,12 +753,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; @@ -764,8 +804,10 @@ Module::Metadata - Gather package and POD information from perl module files =head1 DESCRIPTION -This module provides a standard way to gather metadata about a .pm file -without executing unsafe code. +This module provides a standard way to gather metadata about a .pm file through +(mostly) static analysis and (some) code execution. When determining the +version of a module, the C<$VERSION> assignment is Ced, as is traditional +in the CPAN toolchain. =head1 USAGE @@ -914,7 +956,7 @@ Log::Contextual has already been loaded, otherwise simply calls warn. =item C<< name() >> Returns the name of the package represented by this module. If there -are more than one packages, it makes a best guess based on the +is more than one package, it makes a best guess based on the filename. If it's a script (i.e. not a *.pm) the package name is 'main'. @@ -934,7 +976,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
). It is not filtered for C, C
or private packages the way the -C method does. +C 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() >>