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