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