ce2178719301a01f7cdbbae2eb753eb6938fc1a0
[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.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