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     $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
 460
 461     # Would be nice if we could also check $in_string or something too
 462     last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
 463
 464     if ( $in_pod || $line =~ /^=cut/ ) {
 465
 466       if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
 467         push( @pod, $1 );
 468         if ( $self->{collect_pod} && length( $pod_data ) ) {
 469           $pod{$pod_sect} = $pod_data;
 470           $pod_data = '';
 471         }
 472         $pod_sect = $1;
 473
 474
 475       } elsif ( $self->{collect_pod} ) {
 476         $pod_data .= "$line\n";
 477
 478       }
 479
 480     } else {
 481
 482       $pod_sect = '';
 483       $pod_data = '';
 484
 485       # parse $line to see if it's a $VERSION declaration
 486       my( $vers_sig, $vers_fullname, $vers_pkg ) =
 487           $self->_parse_version_expression( $line );
 488
 489       if ( $line =~ $PKG_REGEXP ) {
 490         $pkg = $1;
 491         push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
 492         $vers{$pkg} = (defined $2 ? $2 : undef)  unless exists( $vers{$pkg} );
 493         $need_vers = defined $2 ? 0 : 1;
 494
 495       # VERSION defined with full package spec, i.e. $Module::VERSION
 496       } elsif ( $vers_fullname && $vers_pkg ) {
 497         push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
 498         $need_vers = 0 if $vers_pkg eq $pkg;
 499
 500         unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
 501           $vers{$vers_pkg} =
 502             $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 503         } else {
 504           # Warn unless the user is using the "$VERSION = eval
 505           # $VERSION" idiom (though there are probably other idioms
 506           # that we should watch out for...)
 507           warn <<"EOM" unless $line =~ /=\s*eval/;
 508 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
 509 ignoring subsequent declaration on line $line_num.
 510 EOM
 511         }
 512
 513       # first non-comment line in undeclared package main is VERSION
 514       } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
 515         $need_vers = 0;
 516         my $v =
 517           $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 518         $vers{$pkg} = $v;
 519         push( @pkgs, 'main' );
 520
 521       # first non-comment line in undeclared package defines package main
 522       } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
 523         $need_vers = 1;
 524         $vers{main} = '';
 525         push( @pkgs, 'main' );
 526
 527       # only keep if this is the first $VERSION seen
 528       } elsif ( $vers_fullname && $need_vers ) {
 529         $need_vers = 0;
 530         my $v =
 531           $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
 532
 533
 534         unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
 535           $vers{$pkg} = $v;
 536         } else {
 537           warn <<"EOM";
 538 Package '$pkg' already declared with version '$vers{$pkg}'
 539 ignoring new version '$v' on line $line_num.
 540 EOM
 541         }
 542
 543       }
 544
 545     }
 546
 547   }
 548
 549   if ( $self->{collect_pod} && length($pod_data) ) {
 550     $pod{$pod_sect} = $pod_data;
 551   }
 552
 553   $self->{versions} = \%vers;
 554   $self->{packages} = \@pkgs;
 555   $self->{pod} = \%pod;
 556   $self->{pod_headings} = \@pod;
 557 }
 558
 559 {
 560 my $pn = 0;
 561 sub _evaluate_version_line {
 562   my $self = shift;
 563   my( $sigil, $var, $line ) = @_;
 564
 565   # Some of this code came from the ExtUtils:: hierarchy.
 566
 567   # We compile into $vsub because 'use version' would cause
 568   # compiletime/runtime issues with local()
 569   my $vsub;
 570   $pn++; # everybody gets their own package
 571   my $eval = qq{BEGIN { q#  Hide from _packages_inside()
 572     #; package Module::Metadata::_version::p$pn;
 573     use version;
 574     no strict;
 575
 576       \$vsub = sub {
 577         local $sigil$var;
 578         \$$var=undef;
 579         $line;
 580         \$$var
 581       };
 582   }};
 583
 584   local $^W;
 585   # Try to get the $VERSION
 586   eval $eval;
 587   # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't
 588   # installed, so we need to hunt in ./lib for it
 589   if ( $@ =~ /Can't locate/ && -d 'lib' ) {
 590     local @INC = ('lib',@INC);
 591     eval $eval;
 592   }
 593   warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
 594     if $@;
 595   (ref($vsub) eq 'CODE') or
 596     croak "failed to build version sub for $self->{filename}";
 597   my $result = eval { $vsub->() };
 598   croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n"
 599     if $@;
 600
 601   # Upgrade it into a version object
 602   my $version = eval { _dwim_version($result) };
 603
 604   croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n"
 605     unless defined $version; # "0" is OK!
 606
 607   return $version;
 608 }
 609 }
 610
 611 # Try to DWIM when things fail the lax version test in obvious ways
 612 {
 613   my @version_prep = (
 614     # Best case, it just works
 615     sub { return shift },
 616
 617     # If we still don't have a version, try stripping any
 618     # trailing junk that is prohibited by lax rules
 619     sub {
 620       my $v = shift;
 621       $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b
 622       return $v;
 623     },
 624
 625     # Activestate apparently creates custom versions like '1.23_45_01', which
 626     # cause version.pm to think it's an invalid alpha.  So check for that
 627     # and strip them
 628     sub {
 629       my $v = shift;
 630       my $num_dots = () = $v =~ m{(\.)}g;
 631       my $num_unders = () = $v =~ m{(_)}g;
 632       my $leading_v = substr($v,0,1) eq 'v';
 633       if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) {
 634         $v =~ s{_}{}g;
 635         $num_unders = () = $v =~ m{(_)}g;
 636       }
 637       return $v;
 638     },
 639
 640     # Worst case, try numifying it like we would have before version objects
 641     sub {
 642       my $v = shift;
 643       no warnings 'numeric';
 644       return 0 + $v;
 645     },
 646
 647   );
 648
 649   sub _dwim_version {
 650     my ($result) = shift;
 651
 652     return $result if ref($result) eq 'version';
 653
 654     my ($version, $error);
 655     for my $f (@version_prep) {
 656       $result = $f->($result);
 657       $version = eval { version->new($result) };
 658       $error ||= $@ if $@; # capture first failure
 659       last if defined $version;
 660     }
 661
 662     croak $error unless defined $version;
 663
 664     return $version;
 665   }
 666 }
 667
 668 ############################################################
 669
 670 # accessors
 671 sub name            { $_[0]->{module}           }
 672
 673 sub filename        { $_[0]->{filename}         }
 674 sub packages_inside { @{$_[0]->{packages}}      }
 675 sub pod_inside      { @{$_[0]->{pod_headings}}  }
 676 sub contains_pod    { $#{$_[0]->{pod_headings}} }
 677
 678 sub version {
 679     my $self = shift;
 680     my $mod  = shift || $self->{module};
 681     my $vers;
 682     if ( defined( $mod ) && length( $mod ) &&
 683          exists( $self->{versions}{$mod} ) ) {
 684         return $self->{versions}{$mod};
 685     } else {
 686         return undef;
 687     }
 688 }
 689
 690 sub pod {
 691     my $self = shift;
 692     my $sect = shift;
 693     if ( defined( $sect ) && length( $sect ) &&
 694          exists( $self->{pod}{$sect} ) ) {
 695         return $self->{pod}{$sect};
 696     } else {
 697         return undef;
 698     }
 699 }
 700
 701 1;
 702
 703 =head1 NAME
 704
 705 Module::Metadata - Gather package and POD information from perl module files
 706
 707 =head1 SYNOPSIS
 708
 709   use Module::Metadata;
 710
 711   # information about a .pm file
 712   my $info = Module::Metadata->new_from_file( $file );
 713   my $version = $info->version;
 714
 715   # CPAN META 'provides' field for .pm files in a directory
 716   my $provides = Module::Metadata->provides(
 717     dir => 'lib', version => 2
 718   );
 719
 720 =head1 DESCRIPTION
 721
 722 This module provides a standard way to gather metadata about a .pm file
 723 without executing unsafe code.
 724
 725 =head1 USAGE
 726
 727 =head2 Class methods
 728
 729 =over 4
 730
 731 =item C<< new_from_file($filename, collect_pod => 1) >>
 732
 733 Construct a C<Module::Metadata> object given the path to a file. Takes an
 734 optional argument C<collect_pod> which is a boolean that determines whether POD
 735 data is collected and stored for reference. POD data is not collected by
 736 default. POD headings are always collected.  Returns undef if the filename
 737 does not exist.
 738
 739 =item C<< new_from_handle($handle, $filename, collect_pod => 1) >>
 740
 741 This works just like C<new_from_file>, except that a handle can be provided
 742 as the first argument.  Note that there is no validation to confirm that the
 743 handle is a handle or something that can act like one.  Passing something that
 744 isn't a handle will cause a exception when trying to read from it.  The
 745 C<filename> argument is mandatory or undef will be returned.
 746
 747 =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >>
 748
 749 Construct a C<Module::Metadata> object given a module or package name. In addition
 750 to accepting the C<collect_pod> argument as described above, this
 751 method accepts a C<inc> argument which is a reference to an array of
 752 of directories to search for the module. If none are given, the
 753 default is @INC.  Returns undef if the module cannot be found.
 754
 755 =item C<< find_module_by_name($module, \@dirs) >>
 756
 757 Returns the path to a module given the module or package name. A list
 758 of directories can be passed in as an optional parameter, otherwise
 759 @INC is searched.
 760
 761 Can be called as either an object or a class method.
 762
 763 =item C<< find_module_dir_by_name($module, \@dirs) >>
 764
 765 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
 766 the module C<$module>. A list of directories can be passed in as an
 767 optional parameter, otherwise @INC is searched.
 768
 769 Can be called as either an object or a class method.
 770
 771 =item C<< provides( %options ) >>
 772
 773 This is a convenience wrapper around C<package_versions_from_directory>
 774 to generate a CPAN META C<provides> data structure.  It takes key/value
 775 pairs.  Valid option keys include:
 776
 777 =over
 778
 779 =item version B<(required)>
 780
 781 Specifies which version of the L<CPAN::Meta::Spec> should be used as
 782 the format of the C<provides> output.  Currently only '1.4' and '2'
 783 are supported (and their format is identical).  This may change in
 784 the future as the definition of C<provides> changes.
 785
 786 The C<version> option is required.  If it is omitted or if
 787 an unsupported version is given, then C<provides> will throw an error.
 788
 789 =item dir
 790
 791 Directory to search recursively for F<.pm> files.  May not be specified with
 792 C<files>.
 793
 794 =item files
 795
 796 Array reference of files to examine.  May not be specified with C<dir>.
 797
 798 =item prefix
 799
 800 String to prepend to the C<file> field of the resulting output. This defaults
 801 to F<lib>, which is the common case for most CPAN distributions with their
 802 F<.pm> files in F<lib>.  This option ensures the META information has the
 803 correct relative path even when the C<dir> or C<files> arguments are
 804 absolute or have relative paths from a location other than the distribution
 805 root.
 806
 807 =back
 808
 809 For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value
 810 is a hashref of the form:
 811
 812   {
 813     'Package::Name' => {
 814       version => '0.123',
 815       file => 'lib/Package/Name.pm'
 816     },
 817     'OtherPackage::Name' => ...
 818   }
 819
 820 =item C<< package_versions_from_directory($dir, \@files?) >>
 821
 822 Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks
 823 for those files in C<$dir> - and reads each file for packages and versions,
 824 returning a hashref of the form:
 825
 826   {
 827     'Package::Name' => {
 828       version => '0.123',
 829       file => 'Package/Name.pm'
 830     },
 831     'OtherPackage::Name' => ...
 832   }
 833
 834 The C<DB> and C<main> packages are always omitted, as are any "private"
 835 packages that have leading underscores in the namespace (e.g.
 836 C<Foo::_private>)
 837
 838 Note that the file path is relative to C<$dir> if that is specified.
 839 This B<must not> be used directly for CPAN META C<provides>.  See
 840 the C<provides> method instead.
 841
 842 =item C<< log_info (internal) >>
 843
 844 Used internally to perform logging; imported from Log::Contextual if
 845 Log::Contextual has already been loaded, otherwise simply calls warn.
 846
 847 =back
 848
 849 =head2 Object methods
 850
 851 =over 4
 852
 853 =item C<< name() >>
 854
 855 Returns the name of the package represented by this module. If there
 856 are more than one packages, it makes a best guess based on the
 857 filename. If it's a script (i.e. not a *.pm) the package name is
 858 'main'.
 859
 860 =item C<< version($package) >>
 861
 862 Returns the version as defined by the $VERSION variable for the
 863 package as returned by the C<name> method if no arguments are
 864 given. If given the name of a package it will attempt to return the
 865 version of that package if it is specified in the file.
 866
 867 =item C<< filename() >>
 868
 869 Returns the absolute path to the file.
 870
 871 =item C<< packages_inside() >>
 872
 873 Returns a list of packages. Note: this is a raw list of packages
 874 discovered (or assumed, in the case of C<main>).  It is not
 875 filtered for C<DB>, C<main> or private packages the way the
 876 C<provides> method does.
 877
 878 =item C<< pod_inside() >>
 879
 880 Returns a list of POD sections.
 881
 882 =item C<< contains_pod() >>
 883
 884 Returns true if there is any POD in the file.
 885
 886 =item C<< pod($section) >>
 887
 888 Returns the POD data in the given section.
 889
 890 =back
 891
 892 =head1 AUTHOR
 893
 894 Original code from Module::Build::ModuleInfo by Ken Williams
 895 <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
 896
 897 Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with
 898 assistance from David Golden (xdg) <dagolden@cpan.org>.
 899
 900 =head1 COPYRIGHT
 901
 902 Original code Copyright (c) 2001-2011 Ken Williams.
 903 Additional code Copyright (c) 2010-2011 Matt Trout and David Golden.
 904 All rights reserved.
 905
 906 This library is free software; you can redistribute it and/or
 907 modify it under the same terms as Perl itself.
 908
 909 =cut
 910