add "provides" method for correct CPAN META field generation

diff --git a/Changes b/Changes
index 5d8a79c..1b7a053 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,7 @@
+1.0.8 (next)
+  - Adds 'provides' method to generate a CPAN META provides data structure
+    correctly; use of package_versions_from_directory is discouraged (DAGOLDEN)
+
 1.0.7 2001-09-07 12:00:00
   - Apply VMS fixes backported from blead (Craig A. Berry)
 

diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm
index e2c83d3..8a1f439 100644 (file)
--- a/lib/Module/Metadata.pm
+++ b/lib/Module/Metadata.pm
@@ -160,6 +160,38 @@ sub new_from_module {
     return \%result;
   };
 
+  sub provides {
+    my $class = shift;
+
+    die "provides() requires key/value pairs \n" if @_ % 2;
+    my %args = @_;
+
+    die "provides() takes only one of 'dir' or 'files'\n"
+      if $args{dir} && $args{files};
+
+    $args{prefix} = 'lib' unless defined $args{prefix};
+
+    my $p;
+    if ( $args{dir} ) {
+      $p = $class->package_versions_from_directory($args{dir});
+    }
+    else {
+      die "provides() requires 'files' to be an array reference\n"
+        unless ref $args{files} eq 'ARRAY';
+      $p = $class->package_versions_from_directory($args{files});
+    }
+
+    # Now, fix up files with prefix
+    if ( length $args{prefix} ) { # check in case disabled with q{}
+      $args{prefix} =~ s{/$}{};
+      for my $v ( values %$p ) {
+        $v->{file} = "$args{prefix}/$v->{file}";
+      }
+    }
+
+    return $p
+  }
+
   sub package_versions_from_directory {
     my ( $class, $dir, $files ) = @_;
 
@@ -673,9 +705,8 @@ Module::Metadata - Gather package and POD information from perl module files
   my $info = Module::Metadata->new_from_file( $file );
   my $version = $info->version;
 
-  # information about a directory full of .pm files
-  my $provides =
-    Module::Metadata->package_versions_from_directory('lib');
+  # CPAN META 'provides' field for .pm files in a directory
+  my $provides = Module::Metadata->provides(dir => 'lib');
 
 =head1 DESCRIPTION
 
@@ -728,6 +759,45 @@ optional parameter, otherwise @INC is searched.
 
 Can be called as either an object or a class method.
 
+=item C<< provides( %options ) >>
+
+This is a convenience wrapper around C<package_versions_from_directory>
+to generate a CPAN META C<provides> data structure.  It takes key/value
+pairs.  Valid option keys include:
+
+=over
+
+=item dir
+
+Directory to search recursively for F<.pm> files.  May not be specified with
+C<files>.
+
+=item files
+
+Array reference of files to examine.  May not be specified with C<dir>.
+
+=item prefix
+
+String to prepend to the C<file> field of the resulting output. This defaults
+to F<lib>, which is the common case for most CPAN distributions with their
+F<.pm> files in F<lib>.  This option ensures the META information has the
+correct relative path even when the C<dir> or C<files> arguments are
+absolute or have relative paths from a location other than the distribution
+root.
+
+=back
+
+For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
+is a hashref of the form:
+
+  {
+    'Package::Name' => {
+      version => '0.123',
+      file => 'lib/Package/Name.pm'
+    },
+    'OtherPackage::Name' => ...
+  }
+
 =item C<< package_versions_from_directory($dir, \@files?) >>
 
 Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
@@ -742,6 +812,14 @@ returning a hashref of the form:
     'OtherPackage::Name' => ...
   }
 
+The C<DB> and C<main> packages are always omitted, as are any "private"
+packages that have leading underscores in the namespace (e.g.
+C<Foo::_private>)
+
+Note that the file path is relative to C<$dir> if that is specified.
+This B<must not> be used directly for CPAN META C<provides>.  See
+the C<provides> method instead.
+
 =item C<< log_info (internal) >>
 
 Used internally to perform logging; imported from Log::Contextual if

diff --git a/t/metadata.t b/t/metadata.t
index ed34351..b93cefb 100644 (file)
--- a/t/metadata.t
+++ b/t/metadata.t
@@ -203,7 +203,7 @@ package Simple v1.2.3_4 {
 );
 my %modules = reverse @modules;
 
-plan tests => 40 + 2 * keys( %modules );
+plan tests => 42 + 2 * keys( %modules );
 
 require_ok('Module::Metadata');
 
@@ -546,5 +546,39 @@ my $exp_pvfd = {
 
 my $got_pvfd = Module::Metadata->package_versions_from_directory('lib');
 
-is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory" )
+is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" )
   or diag explain $got_pvfd;
+
+{
+  my $got_provides = Module::Metadata->provides(dir => 'lib');
+  my $exp_provides = {
+    'Simple' => {
+      'file' => 'lib/Simple.pm',
+      'version' => '0.01'
+    },
+    'Simple::Ex' => {
+      'file' => 'lib/Simple.pm',
+      'version' => '0.02'
+    }
+  };
+
+  is_deeply( $got_provides, $exp_provides, "provides()" )
+    or diag explain $got_provides;
+}
+
+{
+  my $got_provides = Module::Metadata->provides(dir => 'lib', prefix => 'other');
+  my $exp_provides = {
+    'Simple' => {
+      'file' => 'other/Simple.pm',
+      'version' => '0.01'
+    },
+    'Simple::Ex' => {
+      'file' => 'other/Simple.pm',
+      'version' => '0.02'
+    }
+  };
+
+  is_deeply( $got_provides, $exp_provides, "provides()" )
+    or diag explain $got_provides;
+}