lib/Module/Metadata.pm

   1 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
   2 # vim:ts=8:sw=2:et:sta:sts=2
   3 package Module::Metadata;
   4
   5 # Adapted from Perl-licensed code originally distributed with
   6 # Module-Build by Ken Williams
   7
   8 # This module provides routines to gather information about
   9 # perl modules (assuming this may be expanded in the distant
  10 # parrot future to look at other types of modules).
  11
  12 use strict;
  13 use vars qw($VERSION);
  14 $VERSION = '1.000008';
  15 $VERSION = eval $VERSION;
  16
  17 use File::Spec;
  18 use IO::File;
  19 use version 0.87;
  20 BEGIN {
  21   if ($INC{'Log/Contextual.pm'}) {
  22     Log::Contextual->import('log_info');
  23   } else {
  24     *log_info = sub (&) { warn $_[0]->() };
  25   }
  26 }
  27 use File::Find qw(find);
  28
  29 my $V_NUM_REGEXP = qr{v?[0-9._]+};  # crudely, a v-string or decimal
  30
  31 my $PKG_REGEXP  = qr{   # match a package declaration
  32   ^[\s\{;]*             # intro chars on a line
  33   package               # the word 'package'
  34   \s+                   # whitespace
  35   ([\w:]+)              # a package name
  36   \s*                   # optional whitespace
  37   ($V_NUM_REGEXP)?        # optional version number
  38   \s*                   # optional whitesapce
  39   [;\{]                 # semicolon line terminator or block start (since 5.16)
  40 }x;
  41
  42 my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
  43   ([\$*])         # sigil - $ or *
  44   (
  45     (             # optional leading package name
  46       (?:::|\')?  # possibly starting like just :: (Ì  la $::VERSION)
  47       (?:\w+(?:::|\'))*  # Foo::Bar:: ...
  48     )?
  49     VERSION
  50   )\b
  51 }x;
  52
  53 my $VERS_REGEXP = qr{ # match a VERSION definition
  54   (?:
  55     \(\s*$VARNAME_REGEXP\s*\) # with parens
  56   |
  57     $VARNAME_REGEXP           # without parens
  58   )
  59   \s*
  60   =[^=~]  # = but not ==, nor =~
  61 }x;
  62
  63
  64 sub new_from_file {
  65   my $class    = shift;
  66   my $filename = File::Spec->rel2abs( shift );
  67
  68   return undef unless defined( $filename ) && -f $filename;
  69   return $class->_init(undef, $filename, @_);
  70 }
  71
  72 sub new_from_handle {
  73   my $class    = shift;
  74   my $handle   = shift;
  75   my $filename = shift;
  76   return undef unless defined($handle) && defined($filename);
  77   $filename = File::Spec->rel2abs( $filename );
  78
  79   return $class->_init(undef, $filename, @_, handle => $handle);
  80
  81 }
  82
  83
  84 sub new_from_module {
  85   my $class   = shift;
  86   my $module  = shift;
  87   my %props   = @_;
  88
  89   $props{inc} ||= \@INC;
  90   my $filename = $class->find_module_by_name( $module, $props{inc} );
  91   return undef unless defined( $filename ) && -f $filename;
  92   return $class->_init($module, $filename, %props);
  93 }
  94
  95 {
  96
  97   my $compare_versions = sub {
  98     my ($v1, $op, $v2) = @_;
  99     $v1 = version->new($v1)
 100       unless UNIVERSAL::isa($v1,'version');
 101
 102     my $eval_str = "\$v1 $op \$v2";
 103     my $result   = eval $eval_str;
 104     log_info { "error comparing versions: '$eval_str' $@" } if $@;
 105
 106     return $result;
 107   };
 108
 109   my $normalize_version = sub {
 110     my ($version) = @_;
 111     if ( $version =~ /[=<>!,]/ ) { # logic, not just version
 112       # take as is without modification
 113     }
 114     elsif ( ref $version eq 'version' ) { # version objects
 115       $version = $version->is_qv ? $version->normal : $version->stringify;
 116     }
 117     elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
 118       # normalize string tuples without "v": "1.2.3" -> "v1.2.3"
 119       $version = "v$version";
 120     }
 121     else {
 122       # leave alone
 123     }
 124     return $version;
 125   };
 126
 127   # separate out some of the conflict resolution logic
 128
 129   my $resolve_module_versions = sub {
 130     my $packages = shift;
 131
 132     my( $file, $version );
 133     my $err = '';
 134       foreach my $p ( @$packages ) {
 135         if ( defined( $p->{version} ) ) {
 136         if ( defined( $version ) ) {
 137           if ( $compare_versions->( $version, '!=', $p->{version} ) ) {
 138             $err .= "  $p->{file} ($p->{version})\n";
 139           } else {
 140             # same version declared multiple times, ignore
 141           }
 142         } else {
 143           $file    = $p->{file};
 144           $version = $p->{version};
 145         }
 146         }
 147         $file ||= $p->{file} if defined( $p->{file} );
 148       }
 149
 150     if ( $err ) {
 151       $err = "  $file ($version)\n" . $err;
 152     }
 153
 154     my %result = (
 155       file    => $file,
 156       version => $version,
 157       err     => $err
 158     );
 159
 160     return \%result;
 161   };
 162
 163   sub provides {
 164     my $class = shift;
 165
 166     die "provides() requires key/value pairs \n" if @_ % 2;
 167     my %args = @_;
 168
 169     die "provides() takes only one of 'dir' or 'files'\n"
 170       if $args{dir} && $args{files};
 171
 172     $args{prefix} = 'lib' unless defined $args{prefix};
 173
 174     my $p;
 175     if ( $args{dir} ) {
 176       $p = $class->package_versions_from_directory($args{dir});
 177     }
 178     else {
 179       die "provides() requires 'files' to be an array reference\n"
 180         unless ref $args{files} eq 'ARRAY';
 181       $p = $class->package_versions_from_directory($args{files});
 182     }
 183
 184     # Now, fix up files with prefix
 185     if ( length $args{prefix} ) { # check in case disabled with q{}
 186       $args{prefix} =~ s{/$}{};
 187       for my $v ( values %$p ) {
 188         $v->{file} = "$args{prefix}/$v->{file}";
 189       }
 190     }
 191
 192     return $p
 193   }
 194
 195   sub package_versions_from_directory {
 196     my ( $class, $dir, $files ) = @_;
 197
 198     my @files;
 199
 200     if ( $files ) {
 201       @files = @$files;
 202     } else {
 203       find( {
 204         wanted => sub {
 205           push @files, $_ if -f $_ && /\.pm$/;
 206         },
 207         no_chdir => 1,
 208       }, $dir );
 209     }
 210
 211     # First, we enumerate all packages & versions,
 212     # separating into primary & alternative candidates
 213     my( %prime, %alt );
 214     foreach my $file (@files) {
 215       my $mapped_filename = File::Spec->abs2rel( $file, $dir );
 216       my @path = split( /\//, $mapped_filename );
 217       (my $prime_package = join( '::', @path )) =~ s/\.pm$//;
 218
 219       my $pm_info = $class->new_from_file( $file );
 220
 221       foreach my $package ( $pm_info->packages_inside ) {
 222         next if $package eq 'main';  # main can appear numerous times, ignore
 223         next if $package eq 'DB';    # special debugging package, ignore
 224         next if grep /^_/, split( /::/, $package ); # private package, ignore
 225
 226         my $version = $pm_info->version( $package );
 227
 228         if ( $package eq $prime_package ) {
 229           if ( exists( $prime{$package} ) ) {
 230             die "Unexpected conflict in '$package'; multiple versions found.\n";
 231           } else {
 232             $prime{$package}{file} = $mapped_filename;
 233             $prime{$package}{version} = $version if defined( $version );
 234           }
 235         } else {
 236           push( @{$alt{$package}}, {
 237                                     file    => $mapped_filename,
 238                                     version => $version,
 239                                    } );
 240         }
 241       }
 242     }
 243
 244     # Then we iterate over all the packages found above, identifying conflicts
 245     # and selecting the "best" candidate for recording the file & version
 246     # for each package.
 247     foreach my $package ( keys( %alt ) ) {
 248       my $result = $resolve_module_versions->( $alt{$package} );
 249
 250       if ( exists( $prime{$package} ) ) { # primary package selected
 251
 252         if ( $result->{err} ) {
 253         # Use the selected primary package, but there are conflicting
 254         # errors among multiple alternative packages that need to be
 255         # reported
 256           log_info {
 257             "Found conflicting versions for package '$package'\n" .
 258             "  $prime{$package}{file} ($prime{$package}{version})\n" .
 259             $result->{err}
 260           };
 261
 262         } elsif ( defined( $result->{version} ) ) {
 263         # There is a primary package selected, and exactly one
 264         # alternative package
 265
 266         if ( exists( $prime{$package}{version} ) &&
 267              defined( $prime{$package}{version} ) ) {
 268           # Unless the version of the primary package agrees with the
 269           # version of the alternative package, report a conflict
 270           if ( $compare_versions->(
 271                  $prime{$package}{version}, '!=', $result->{version}
 272                )
 273              ) {
 274
 275             log_info {
 276               "Found conflicting versions for package '$package'\n" .
 277               "  $prime{$package}{file} ($prime{$package}{version})\n" .
 278               "  $result->{file} ($result->{version})\n"
 279             };
 280           }
 281
 282         } else {
 283           # The prime package selected has no version so, we choose to
 284           # use any alternative package that does have a version
 285           $prime{$package}{file}    = $result->{file};
 286           $prime{$package}{version} = $result->{version};
 287         }
 288
 289         } else {
 290         # no alt package found with a version, but we have a prime
 291         # package so we use it whether it has a version or not
 292         }
 293
 294       } else { # No primary package was selected, use the best alternative
 295
 296         if ( $result->{err} ) {
 297           log_info {
 298             "Found conflicting versions for package '$package'\n" .
 299             $result->{err}
 300           };
 301         }
 302
 303         # Despite possible conflicting versions, we choose to record
 304         # something rather than nothing
 305         $prime{$package}{file}    = $result->{file};
 306         $prime{$package}{version} = $result->{version}
 307           if defined( $result->{version} );
 308       }
 309     }
 310
 311     # Normalize versions.  Can't use exists() here because of bug in YAML::Node.
 312     # XXX "bug in YAML::Node" comment seems irrelvant -- dagolden, 2009-05-18
 313     for (grep defined $_->{version}, values %prime) {
 314       $_->{version} = $normalize_version->( $_->{version} );
 315     }
 316
 317     return \%prime;
 318   }
 319 }
 320
 321
 322 sub _init {
 323   my $class    = shift;
 324   my $module   = shift;
 325   my $filename = shift;
 326   my %props = @_;
 327
 328   my $handle = delete $props{handle};
 329   my( %valid_props, @valid_props );
 330   @valid_props = qw( collect_pod inc );
 331   @valid_props{@valid_props} = delete( @props{@valid_props} );
 332   warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
 333
 334   my %data = (
 335     module       => $module,
 336     filename     => $filename,
 337     version      => undef,
 338     packages     => [],
 339     versions     => {},
 340     pod          => {},
 341     pod_headings => [],
 342     collect_pod  => 0,
 343
 344     %valid_props,
 345   );
 346
 347   my $self = bless(\%data, $class);
 348
 349   if ( $handle ) {
 350     $self->_parse_fh($handle);
 351   }
 352   else {
 353     $self->_parse_file();
 354   }
 355
 356   unless($self->{module} and length($self->{module})) {
 357     my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
 358     if($f =~ /\.pm$/) {
 359       $f =~ s/\..+$//;
 360       my @candidates = grep /$f$/, @{$self->{packages}};
 361       $self->{module} = shift(@candidates); # punt
 362     }
 363     else {
 364       if(grep /main/, @{$self->{packages}}) {
 365         $self->{module} = 'main';
 366       }
 367       else {
 368         $self->{module} = $self->{packages}[0] || '';
 369       }
 370     }
 371   }
 372
 373   $self->{version} = $self->{versions}{$self->{module}}
 374       if defined( $self->{module} );
 375
 376   return $self;
 377 }
 378
 379 # class method
 380 sub _do_find_module {
 381   my $class   = shift;
 382   my $module  = shift || die 'find_module_by_name() requires a package name';
 383   my $dirs    = shift || \@INC;
 384
 385   my $file = File::Spec->catfile(split( /::/, $module));
 386   foreach my $dir ( @$dirs ) {
 387     my $testfile = File::Spec->catfile($dir, $file);
 388     return [ File::Spec->rel2abs( $testfile ), $dir ]
 389         if -e $testfile and !-d _;  # For stuff like ExtUtils::xsubpp
 390     return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
 391         if -e "$testfile.pm";
 392   }
 393   return;
 394 }
 395
 396 # class method
 397 sub find_module_by_name {
 398   my $found = shift()->_do_find_module(@_) or return;
 399   return $found->[0];
 400 }
 401
 402 # class method
 403 sub find_module_dir_by_name {
 404   my $found = shift()->_do_find_module(@_) or return;
 405   return $found->[1];
 406 }
 407
 408
 409 # given a line of perl code, attempt to parse it if it looks like a
 410 # $VERSION assignment, returning sigil, full name, & package name
 411 sub _parse_version_expression {
 412   my $self = shift;
 413   my $line = shift;
 414
 415   my( $sig, $var, $pkg );
 416   if ( $line =~ $VERS_REGEXP ) {
 417     ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
 418     if ( $pkg ) {
 419       $pkg = ($pkg eq '::') ? 'main' : $pkg;
 420       $pkg =~ s/::$//;
 421     }
 422   }
 423
 424   return ( $sig, $var, $pkg );
 425 }
 426
 427 sub _parse_file {
 428   my $self = shift;
 429
 430   my $filename = $self->{filename};
 431   my $fh = IO::File->new( $filename )
 432     or die( "Can't open '$filename': $!" );
 433
 434   $self->_parse_fh($fh);
 435 }
 436
 437 sub _parse_fh {
 438   my ($self, $fh) = @_;
 439
 440   my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
 441   my( @pkgs, %vers, %pod, @pod );
 442   my $pkg = 'main';
 443   my $pod_sect = '';
 444   my $pod_data = '';
 445
 446   while (defined( my $line = <$fh> )) {
 447     my $line_num = $.;
 448
 449     chomp( $line );
 450     next if $line =~ /^\s*#/;
 451
 452     $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
 453
 454     # Would be nice if we could also check $in_string or something too
 455     last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
 456
 457     if ( $in_pod || $line =~ /^=cut/ ) {
 458
 459       if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
 460         push( @pod, $1 );
 461         if ( $self->{collect_pod} && length( $pod_data ) ) {
 462           $pod{$pod_sect} = $pod_data;
 463           $pod_data = '';
 464         }
 465         $pod_sect = $1;
 466
 467
 468       } elsif ( $self->{collect_pod} ) {
 469         $pod_data .= "$line\n";
 470
 471       }
 472
 473     } else {
 474
 475       $pod_sect = '';
 476       $pod_data = '';
 477
 478       # parse $line to see if it's a $VERSION declaration
 479       my( $vers_sig, $vers_fullname, $vers_pkg ) =
 480           $self->_parse_version_expression( $line );
 481
 482       if ( $line =~ $PKG_REGEXP ) {
 483         $pkg = $1;
 484         push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
 485         $vers{$pkg} = (defined $2 ? $2 : undef)  unless exists( $vers{$pkg} );
 486         $need_vers = defined $2 ? 0 : 1;
 487
 488       # VERSION defined with full package spec, i.e. $Module::VERSION
 489       } elsif ( $vers_fullname && $vers_pkg ) {
 490         push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
 491         $need_vers = 0 if $vers_pkg eq $pkg;
 492
 493         unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
 494           $vers{$vers_pkg} =
 495             $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 496         } else {
 497           # Warn unless the user is using the "$VERSION = eval
 498           # $VERSION" idiom (though there are probably other idioms
 499           # that we should watch out for...)
 500           warn <<"EOM" unless $line =~ /=\s*eval/;
 501 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
 502 ignoring subsequent declaration on line $line_num.
 503 EOM
 504         }
 505
 506       # first non-comment line in undeclared package main is VERSION
 507       } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
 508         $need_vers = 0;
 509         my $v =
 510           $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 511         $vers{$pkg} = $v;
 512         push( @pkgs, 'main' );
 513
 514       # first non-comment line in undeclared package defines package main
 515       } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
 516         $need_vers = 1;
 517         $vers{main} = '';
 518         push( @pkgs, 'main' );
 519
 520       # only keep if this is the first $VERSION seen
 521       } elsif ( $vers_fullname && $need_vers ) {
 522         $need_vers = 0;
 523         my $v =
 524           $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 525
 526
 527         unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
 528           $vers{$pkg} = $v;
 529         } else {
 530           warn <<"EOM";
 531 Package '$pkg' already declared with version '$vers{$pkg}'
 532 ignoring new version '$v' on line $line_num.
 533 EOM
 534         }
 535
 536       }
 537
 538     }
 539
 540   }
 541
 542   if ( $self->{collect_pod} && length($pod_data) ) {
 543     $pod{$pod_sect} = $pod_data;
 544   }
 545
 546   $self->{versions} = \%vers;
 547   $self->{packages} = \@pkgs;
 548   $self->{pod} = \%pod;
 549   $self->{pod_headings} = \@pod;
 550 }
 551
 552 {
 553 my $pn = 0;
 554 sub _evaluate_version_line {
 555   my $self = shift;
 556   my( $sigil, $var, $line ) = @_;
 557
 558   # Some of this code came from the ExtUtils:: hierarchy.
 559
 560   # We compile into $vsub because 'use version' would cause
 561   # compiletime/runtime issues with local()
 562   my $vsub;
 563   $pn++; # everybody gets their own package
 564   my $eval = qq{BEGIN { q#  Hide from _packages_inside()
 565     #; package Module::Metadata::_version::p$pn;
 566     use version;
 567     no strict;
 568
 569       \$vsub = sub {
 570         local $sigil$var;
 571         \$$var=undef;
 572         $line;
 573         \$$var
 574       };
 575   }};
 576
 577   local $^W;
 578   # Try to get the $VERSION
 579   eval $eval;
 580   # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
 581   # installed, so we need to hunt in ./lib for it
 582   if ( $@ =~ /Can't locate/ && -d 'lib' ) {
 583     local @INC = ('lib',@INC);
 584     eval $eval;
 585   }
 586   warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
 587     if $@;
 588   (ref($vsub) eq 'CODE') or
 589     die "failed to build version sub for $self->{filename}";
 590   my $result = eval { $vsub->() };
 591   die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
 592     if $@;
 593
 594   # Upgrade it into a version object
 595   my $version = eval { _dwim_version($result) };
 596
 597   die "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
 598     unless defined $version; # "0" is OK!
 599
 600   return $version;
 601 }
 602 }
 603
 604 # Try to DWIM when things fail the lax version test in obvious ways
 605 {
 606   my @version_prep = (
 607     # Best case, it just works
 608     sub { return shift },
 609
 610     # If we still don't have a version, try stripping any
 611     # trailing junk that is prohibited by lax rules
 612     sub {
 613       my $v = shift;
 614       $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
 615       return $v;
 616     },
 617
 618     # Activestate apparently creates custom versions like '1.23_45_01', which
 619     # cause version.pm to think it's an invalid alpha.  So check for that
 620     # and strip them
 621     sub {
 622       my $v = shift;
 623       my $num_dots = () = $v =~ m{(\.)}g;
 624       my $num_unders = () = $v =~ m{(_)}g;
 625       my $leading_v = substr($v,0,1) eq 'v';
 626       if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
 627         $v =~ s{_}{}g;
 628         $num_unders = () = $v =~ m{(_)}g;
 629       }
 630       return $v;
 631     },
 632
 633     # Worst case, try numifying it like we would have before version objects
 634     sub {
 635       my $v = shift;
 636       no warnings 'numeric';
 637       return 0 + $v;
 638     },
 639
 640   );
 641
 642   sub _dwim_version {
 643     my ($result) = shift;
 644
 645     return $result if ref($result) eq 'version';
 646
 647     my ($version, $error);
 648     for my $f (@version_prep) {
 649       $result = $f->($result);
 650       $version = eval { version->new($result) };
 651       $error ||= $@ if $@; # capture first failure
 652       last if defined $version;
 653     }
 654
 655     die $error unless defined $version;
 656
 657     return $version;
 658   }
 659 }
 660
 661 ############################################################
 662
 663 # accessors
 664 sub name            { $_[0]->{module}           }
 665
 666 sub filename        { $_[0]->{filename}         }
 667 sub packages_inside { @{$_[0]->{packages}}      }
 668 sub pod_inside      { @{$_[0]->{pod_headings}}  }
 669 sub contains_pod    { $#{$_[0]->{pod_headings}} }
 670
 671 sub version {
 672     my $self = shift;
 673     my $mod  = shift || $self->{module};
 674     my $vers;
 675     if ( defined( $mod ) && length( $mod ) &&
 676          exists( $self->{versions}{$mod} ) ) {
 677         return $self->{versions}{$mod};
 678     } else {
 679         return undef;
 680     }
 681 }
 682
 683 sub pod {
 684     my $self = shift;
 685     my $sect = shift;
 686     if ( defined( $sect ) && length( $sect ) &&
 687          exists( $self->{pod}{$sect} ) ) {
 688         return $self->{pod}{$sect};
 689     } else {
 690         return undef;
 691     }
 692 }
 693
 694 1;
 695
 696 =head1 NAME
 697
 698 Module::Metadata - Gather package and POD information from perl module files
 699
 700 =head1 SYNOPSIS
 701
 702   use Module::Metadata;
 703
 704   # information about a .pm file
 705   my $info = Module::Metadata->new_from_file( $file );
 706   my $version = $info->version;
 707
 708   # CPAN META 'provides' field for .pm files in a directory
 709   my $provides = Module::Metadata->provides(dir => 'lib');
 710
 711 =head1 DESCRIPTION
 712
 713 This module provides a standard way to gather metadata about a .pm file
 714 without executing unsafe code.
 715
 716 =head1 USAGE
 717
 718 =head2 Class methods
 719
 720 =over 4
 721
 722 =item C<< new_from_file($filename, collect_pod => 1) >>
 723
 724 Construct a C<Module::Metadata> object given the path to a file. Takes an
 725 optional argument C<collect_pod> which is a boolean that determines whether POD
 726 data is collected and stored for reference. POD data is not collected by
 727 default. POD headings are always collected.  Returns undef if the filename
 728 does not exist.
 729
 730 =item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
 731
 732 This works just like C<new_from_file>, except that a handle can be provided
 733 as the first argument.  Note that there is no validation to confirm that the
 734 handle is a handle or something that can act like one.  Passing something that
 735 isn't a handle will cause a exception when trying to read from it.  The
 736 C<filename> argument is mandatory or undef will be returned.
 737
 738 =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
 739
 740 Construct a C<Module::Metadata> object given a module or package name. In addition
 741 to accepting the C<collect_pod> argument as described above, this
 742 method accepts a C<inc> argument which is a reference to an array of
 743 of directories to search for the module. If none are given, the
 744 default is @INC.  Returns undef if the module cannot be found.
 745
 746 =item C<< find_module_by_name($module, \@dirs) >>
 747
 748 Returns the path to a module given the module or package name. A list
 749 of directories can be passed in as an optional parameter, otherwise
 750 @INC is searched.
 751
 752 Can be called as either an object or a class method.
 753
 754 =item C<< find_module_dir_by_name($module, \@dirs) >>
 755
 756 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
 757 the module C<$module>. A list of directories can be passed in as an
 758 optional parameter, otherwise @INC is searched.
 759
 760 Can be called as either an object or a class method.
 761
 762 =item C<< provides( %options ) >>
 763
 764 This is a convenience wrapper around C<package_versions_from_directory>
 765 to generate a CPAN META C<provides> data structure.  It takes key/value
 766 pairs.  Valid option keys include:
 767
 768 =over
 769
 770 =item dir
 771
 772 Directory to search recursively for F<.pm> files.  May not be specified with
 773 C<files>.
 774
 775 =item files
 776
 777 Array reference of files to examine.  May not be specified with C<dir>.
 778
 779 =item prefix
 780
 781 String to prepend to the C<file> field of the resulting output. This defaults
 782 to F<lib>, which is the common case for most CPAN distributions with their
 783 F<.pm> files in F<lib>.  This option ensures the META information has the
 784 correct relative path even when the C<dir> or C<files> arguments are
 785 absolute or have relative paths from a location other than the distribution
 786 root.
 787
 788 =back
 789
 790 For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
 791 is a hashref of the form:
 792
 793   {
 794     'Package::Name' => {
 795       version => '0.123',
 796       file => 'lib/Package/Name.pm'
 797     },
 798     'OtherPackage::Name' => ...
 799   }
 800
 801 =item C<< package_versions_from_directory($dir, \@files?) >>
 802
 803 Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
 804 for those files in C<$dir> - and reads each file for packages and versions,
 805 returning a hashref of the form:
 806
 807   {
 808     'Package::Name' => {
 809       version => '0.123',
 810       file => 'Package/Name.pm'
 811     },
 812     'OtherPackage::Name' => ...
 813   }
 814
 815 The C<DB> and C<main> packages are always omitted, as are any "private"
 816 packages that have leading underscores in the namespace (e.g.
 817 C<Foo::_private>)
 818
 819 Note that the file path is relative to C<$dir> if that is specified.
 820 This B<must not> be used directly for CPAN META C<provides>.  See
 821 the C<provides> method instead.
 822
 823 =item C<< log_info (internal) >>
 824
 825 Used internally to perform logging; imported from Log::Contextual if
 826 Log::Contextual has already been loaded, otherwise simply calls warn.
 827
 828 =back
 829
 830 =head2 Object methods
 831
 832 =over 4
 833
 834 =item C<< name() >>
 835
 836 Returns the name of the package represented by this module. If there
 837 are more than one packages, it makes a best guess based on the
 838 filename. If it's a script (i.e. not a *.pm) the package name is
 839 'main'.
 840
 841 =item C<< version($package) >>
 842
 843 Returns the version as defined by the $VERSION variable for the
 844 package as returned by the C<name> method if no arguments are
 845 given. If given the name of a package it will attempt to return the
 846 version of that package if it is specified in the file.
 847
 848 =item C<< filename() >>
 849
 850 Returns the absolute path to the file.
 851
 852 =item C<< packages_inside() >>
 853
 854 Returns a list of packages. Note: this is a raw list of packages
 855 discovered (or assumed, in the case of C<main>).  It is not
 856 filtered for C<DB>, C<main> or private packages the way the
 857 C<provides> method does.
 858
 859 =item C<< pod_inside() >>
 860
 861 Returns a list of POD sections.
 862
 863 =item C<< contains_pod() >>
 864
 865 Returns true if there is any POD in the file.
 866
 867 =item C<< pod($section) >>
 868
 869 Returns the POD data in the given section.
 870
 871 =back
 872
 873 =head1 AUTHOR
 874
 875 Original code from Module::Build::ModuleInfo by Ken Williams
 876 <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
 877
 878 Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
 879 assistance from David Golden (xdg) <dagolden@cpan.org>.
 880
 881 =head1 COPYRIGHT
 882
 883 Original code Copyright (c) 2001-2011 Ken Williams.
 884 Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
 885 All rights reserved.
 886
 887 This library is free software; you can redistribute it and/or
 888 modify it under the same terms as Perl itself.
 889
 890 =cut
 891