X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FModule%2FMetadata.pm;h=ce2178719301a01f7cdbbae2eb753eb6938fc1a0;hb=02f819d95af6eb2d5937ecbacdea638395850eaa;hp=52394a3beda58c20527ea7f0ff53ddaa8b122573;hpb=a01168d697043db491ce3102a6c2743a18db5227;p=p5sagit%2FModule-Metadata.git diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm index 52394a3..ce21787 100644 --- a/lib/Module/Metadata.pm +++ b/lib/Module/Metadata.pm @@ -11,9 +11,10 @@ package Module::Metadata; use strict; use vars qw($VERSION); -$VERSION = '1.000008'; +$VERSION = '1.000010'; $VERSION = eval $VERSION; +use Carp qw/croak/; use File::Spec; use IO::File; use version 0.87; @@ -163,12 +164,18 @@ sub new_from_module { sub provides { my $class = shift; - die "provides() requires key/value pairs \n" if @_ % 2; + croak "provides() requires key/value pairs \n" if @_ % 2; my %args = @_; - die "provides() takes only one of 'dir' or 'files'\n" + croak "provides() takes only one of 'dir' or 'files'\n" if $args{dir} && $args{files}; + croak "provides() requires a 'version' argument" + unless defined $args{version}; + + croak "provides() does not support version '$args{version}' metadata" + unless grep { $args{version} eq $_ } qw/1.4 2/; + $args{prefix} = 'lib' unless defined $args{prefix}; my $p; @@ -176,7 +183,7 @@ sub new_from_module { $p = $class->package_versions_from_directory($args{dir}); } else { - die "provides() requires 'files' to be an array reference\n" + croak "provides() requires 'files' to be an array reference\n" unless ref $args{files} eq 'ARRAY'; $p = $class->package_versions_from_directory($args{files}); } @@ -212,7 +219,7 @@ sub new_from_module { # separating into primary & alternative candidates my( %prime, %alt ); foreach my $file (@files) { - my $mapped_filename = File::Spec->abs2rel( $file, $dir ); + my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir ); my @path = split( /\//, $mapped_filename ); (my $prime_package = join( '::', @path )) =~ s/\.pm$//; @@ -225,10 +232,12 @@ sub new_from_module { 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} ) ) { - die "Unexpected conflict in '$package'; multiple versions found.\n"; + croak "Unexpected conflict in '$package'; multiple versions found.\n"; } else { + $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename); $prime{$package}{file} = $mapped_filename; $prime{$package}{version} = $version if defined( $version ); } @@ -379,7 +388,7 @@ sub _init { # class method sub _do_find_module { my $class = shift; - my $module = shift || die 'find_module_by_name() requires a package name'; + my $module = shift || croak 'find_module_by_name() requires a package name'; my $dirs = shift || \@INC; my $file = File::Spec->catfile(split( /::/, $module)); @@ -413,7 +422,7 @@ sub _parse_version_expression { my $line = shift; my( $sig, $var, $pkg ); - if ( $line =~ $VERS_REGEXP ) { + if ( $line =~ /$VERS_REGEXP/o ) { ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); if ( $pkg ) { $pkg = ($pkg eq '::') ? 'main' : $pkg; @@ -429,7 +438,7 @@ sub _parse_file { my $filename = $self->{filename}; my $fh = IO::File->new( $filename ) - or die( "Can't open '$filename': $!" ); + or croak( "Can't open '$filename': $!" ); $self->_parse_fh($fh); } @@ -449,12 +458,16 @@ sub _parse_fh { chomp( $line ); next if $line =~ /^\s*#/; - $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod; + my $is_cut; + if ( $line =~ /^=(.{0,3})/ ) { + $is_cut = $1 eq 'cut'; + $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 || $line =~ /^=cut/ ) { + if ( $in_pod || $is_cut ) { if ( $line =~ /^=head\d\s+(.+)\s*$/ ) { push( @pod, $1 ); @@ -477,9 +490,11 @@ sub _parse_fh { # parse $line to see if it's a $VERSION declaration my( $vers_sig, $vers_fullname, $vers_pkg ) = - $self->_parse_version_expression( $line ); + ($line =~ /VERSION/) + ? $self->_parse_version_expression( $line ) + : (); - if ( $line =~ $PKG_REGEXP ) { + if ( $line =~ /$PKG_REGEXP/o ) { $pkg = $1; push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); $vers{$pkg} = (defined $2 ? $2 : undef) unless exists( $vers{$pkg} ); @@ -586,15 +601,15 @@ sub _evaluate_version_line { warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@; (ref($vsub) eq 'CODE') or - die "failed to build version sub for $self->{filename}"; + croak "failed to build version sub for $self->{filename}"; my $result = eval { $vsub->() }; - die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" + croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@; # Upgrade it into a version object my $version = eval { _dwim_version($result) }; - die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" + croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" unless defined $version; # "0" is OK! return $version; @@ -652,7 +667,7 @@ sub _evaluate_version_line { last if defined $version; } - die $error unless defined $version; + croak $error unless defined $version; return $version; } @@ -706,7 +721,9 @@ Module::Metadata - Gather package and POD information from perl module files my $version = $info->version; # CPAN META 'provides' field for .pm files in a directory - my $provides = Module::Metadata->provides(dir => 'lib'); + my $provides = Module::Metadata->provides( + dir => 'lib', version => 2 + ); =head1 DESCRIPTION @@ -767,6 +784,16 @@ pairs. Valid option keys include: =over +=item version B<(required)> + +Specifies which version of the L should be used as +the format of the C output. Currently only '1.4' and '2' +are supported (and their format is identical). This may change in +the future as the definition of C changes. + +The C option is required. If it is omitted or if +an unsupported version is given, then C will throw an error. + =item dir Directory to search recursively for F<.pm> files. May not be specified with