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