Add new_from_handle method [RT #68875]

[p5sagit/Module-Metadata.git] / lib / Module / Metadata.pm

diff --git a/lib/Module/Metadata.pm b/lib/Module/Metadata.pm
index e02b48f..8629a98 100644 (file)
--- 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.000003';
+$VERSION = '1.000005';
 $VERSION = eval $VERSION;
 
 use File::Spec;
@@ -69,6 +69,18 @@ sub new_from_file {
   return $class->_init(undef, $filename, @_);
 }
 
+sub new_from_handle {
+  my $class    = shift;
+  my $handle   = shift;
+  my $filename = shift;
+  return undef unless defined($handle) && defined($filename);
+  $filename = File::Spec->rel2abs( $filename );
+
+  return $class->_init(undef, $filename, @_, handle => $handle);
+
+}
+
+
 sub new_from_module {
   my $class   = shift;
   my $module  = shift;
@@ -183,7 +195,6 @@ sub new_from_module {
   
         if ( $package eq $prime_package ) {
           if ( exists( $prime{$package} ) ) {
-            # M::B::ModuleInfo will handle this conflict
             die "Unexpected conflict in '$package'; multiple versions found.\n";
           } else {
             $prime{$package}{file} = $mapped_filename;
@@ -282,6 +293,7 @@ sub _init {
   my $filename = shift;
   my %props = @_;
 
+  my $handle = delete $props{handle};
   my( %valid_props, @valid_props );
   @valid_props = qw( collect_pod inc );
   @valid_props{@valid_props} = delete( @props{@valid_props} );
@@ -302,7 +314,12 @@ sub _init {
 
   my $self = bless(\%data, $class);
 
-  $self->_parse_file();
+  if ( $handle ) {
+    $self->_parse_fh($handle);
+  }
+  else {
+    $self->_parse_file();
+  }
 
   unless($self->{module} and length($self->{module})) {
     my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
@@ -517,9 +534,9 @@ sub _evaluate_version_line {
     use version;
     no strict;
 
-    local $sigil$var;
-    \$$var=undef;
       \$vsub = sub {
+        local $sigil$var;
+        \$$var=undef;
         $line;
         \$$var
       };
@@ -654,19 +671,28 @@ Module::Metadata - Gather package and POD information from perl module files
 
 =item new_from_file($filename, collect_pod => 1)
 
-Construct a C<ModuleInfo> object given the path to a file. Takes an optional
+Construct a C<Module::Metadata> object given the path to a file. Takes an optional
 argument C<collect_pod> which is a boolean that determines whether
 POD data is collected and stored for reference. POD data is not
 collected by default. POD headings are always collected.
 
+=item new_from_handle($handle, $filename, collect_pod => 1)
+
+This works just like C<new_from_file>, except that a handle can be provided
+as the first argument.  Note that there is no validation to confirm that the
+handle is a handle or something that can act like one.  Passing something that
+isn't a handle will cause a exception when trying to read from it.  The
+C<filename> argument is mandatory or undef will be returned.
+
 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
 
-Construct a C<ModuleInfo> object given a module or package name. In addition
+Construct a C<Module::Metadata> object given a module or package name. In addition
 to accepting the C<collect_pod> argument as described above, this
 method accepts a C<inc> argument which is a reference to an array of
 of directories to search for the module. If none are given, the
 default is @INC.
 
+
 =item name()
 
 Returns the name of the package represented by this module. If there