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