1# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- 2# vim:ts=8:sw=2:et:sta:sts=2 3package 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 12use strict; 13use vars qw($VERSION); 14$VERSION = '1.000009'; 15$VERSION = eval $VERSION; 16 17use Carp qw/croak/; 18use File::Spec; 19use IO::File; 20use version 0.87; 21BEGIN { 22 if ($INC{'Log/Contextual.pm'}) { 23 Log::Contextual->import('log_info'); 24 } else { 25 *log_info = sub (&) { warn $_[0]->() }; 26 } 27} 28use File::Find qw(find); 29 30my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal 31 32my $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 43my $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 54my $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 65sub 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 73sub 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 85sub 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 329sub _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 387sub _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 404sub find_module_by_name { 405 my $found = shift()->_do_find_module(@_) or return; 406 return $found->[0]; 407} 408 409# class method 410sub 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 418sub _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 434sub _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 444sub _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/; 508Package '$vers_pkg' already declared with version '$vers{$vers_pkg}', 509ignoring subsequent declaration on line $line_num. 510EOM 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"; 538Package '$pkg' already declared with version '$vers{$pkg}' 539ignoring new version '$v' on line $line_num. 540EOM 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{ 560my $pn = 0; 561sub _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 671sub name { $_[0]->{module} } 672 673sub filename { $_[0]->{filename} } 674sub packages_inside { @{$_[0]->{packages}} } 675sub pod_inside { @{$_[0]->{pod_headings}} } 676sub contains_pod { $#{$_[0]->{pod_headings}} } 677 678sub 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 690sub 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 7011; 702 703=head1 NAME 704 705Module::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 722This module provides a standard way to gather metadata about a .pm file 723without 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 733Construct a C<Module::Metadata> object given the path to a file. Takes an 734optional argument C<collect_pod> which is a boolean that determines whether POD 735data is collected and stored for reference. POD data is not collected by 736default. POD headings are always collected. Returns undef if the filename 737does not exist. 738 739=item C<< new_from_handle($handle, $filename, collect_pod => 1) >> 740 741This works just like C<new_from_file>, except that a handle can be provided 742as the first argument. Note that there is no validation to confirm that the 743handle is a handle or something that can act like one. Passing something that 744isn't a handle will cause a exception when trying to read from it. The 745C<filename> argument is mandatory or undef will be returned. 746 747=item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >> 748 749Construct a C<Module::Metadata> object given a module or package name. In addition 750to accepting the C<collect_pod> argument as described above, this 751method accepts a C<inc> argument which is a reference to an array of 752of directories to search for the module. If none are given, the 753default is @INC. Returns undef if the module cannot be found. 754 755=item C<< find_module_by_name($module, \@dirs) >> 756 757Returns the path to a module given the module or package name. A list 758of directories can be passed in as an optional parameter, otherwise 759@INC is searched. 760 761Can be called as either an object or a class method. 762 763=item C<< find_module_dir_by_name($module, \@dirs) >> 764 765Returns the entry in C<@dirs> (or C<@INC> by default) that contains 766the module C<$module>. A list of directories can be passed in as an 767optional parameter, otherwise @INC is searched. 768 769Can be called as either an object or a class method. 770 771=item C<< provides( %options ) >> 772 773This is a convenience wrapper around C<package_versions_from_directory> 774to generate a CPAN META C<provides> data structure. It takes key/value 775pairs. Valid option keys include: 776 777=over 778 779=item version B<(required)> 780 781Specifies which version of the L<CPAN::Meta::Spec> should be used as 782the format of the C<provides> output. Currently only '1.4' and '2' 783are supported (and their format is identical). This may change in 784the future as the definition of C<provides> changes. 785 786The C<version> option is required. If it is omitted or if 787an unsupported version is given, then C<provides> will throw an error. 788 789=item dir 790 791Directory to search recursively for F<.pm> files. May not be specified with 792C<files>. 793 794=item files 795 796Array reference of files to examine. May not be specified with C<dir>. 797 798=item prefix 799 800String to prepend to the C<file> field of the resulting output. This defaults 801to F<lib>, which is the common case for most CPAN distributions with their 802F<.pm> files in F<lib>. This option ensures the META information has the 803correct relative path even when the C<dir> or C<files> arguments are 804absolute or have relative paths from a location other than the distribution 805root. 806 807=back 808 809For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value 810is 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 822Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks 823for those files in C<$dir> - and reads each file for packages and versions, 824returning 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 834The C<DB> and C<main> packages are always omitted, as are any "private" 835packages that have leading underscores in the namespace (e.g. 836C<Foo::_private>) 837 838Note that the file path is relative to C<$dir> if that is specified. 839This B<must not> be used directly for CPAN META C<provides>. See 840the C<provides> method instead. 841 842=item C<< log_info (internal) >> 843 844Used internally to perform logging; imported from Log::Contextual if 845Log::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 855Returns the name of the package represented by this module. If there 856are more than one packages, it makes a best guess based on the 857filename. If it's a script (i.e. not a *.pm) the package name is 858'main'. 859 860=item C<< version($package) >> 861 862Returns the version as defined by the $VERSION variable for the 863package as returned by the C<name> method if no arguments are 864given. If given the name of a package it will attempt to return the 865version of that package if it is specified in the file. 866 867=item C<< filename() >> 868 869Returns the absolute path to the file. 870 871=item C<< packages_inside() >> 872 873Returns a list of packages. Note: this is a raw list of packages 874discovered (or assumed, in the case of C<main>). It is not 875filtered for C<DB>, C<main> or private packages the way the 876C<provides> method does. 877 878=item C<< pod_inside() >> 879 880Returns a list of POD sections. 881 882=item C<< contains_pod() >> 883 884Returns true if there is any POD in the file. 885 886=item C<< pod($section) >> 887 888Returns the POD data in the given section. 889 890=back 891 892=head1 AUTHOR 893 894Original code from Module::Build::ModuleInfo by Ken Williams 895<kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org> 896 897Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with 898assistance from David Golden (xdg) <dagolden@cpan.org>. 899 900=head1 COPYRIGHT 901 902Original code Copyright (c) 2001-2011 Ken Williams. 903Additional code Copyright (c) 2010-2011 Matt Trout and David Golden. 904All rights reserved. 905 906This library is free software; you can redistribute it and/or 907modify it under the same terms as Perl itself. 908 909=cut 910 911