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