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