1 package Module::Build::ModuleInfo;
3 # This module provides routines to gather information about
4 # perl modules (assuming this may be expanded in the distant
5 # parrot future to look at other types of modules).
11 use Module::Build::Version;
14 my $PKG_REGEXP = qr/ # match a package declaration
15 ^[\s\{;]* # intro chars on a line
16 package # the word 'package'
18 ([\w:]+) # a package name
19 \s* # optional whitespace
20 ; # semicolon line terminator
23 my $VARNAME_REGEXP = qr/ # match fully-qualified VERSION name
24 ([\$*]) # sigil - $ or *
26 ( # optional leading package name
27 (?:::|\')? # possibly starting like just :: (ala $::VERSION)
28 (?:\w+(?:::|\'))* # Foo::Bar:: ...
34 my $VERS_REGEXP = qr/ # match a VERSION definition
36 \(\s*$VARNAME_REGEXP\s*\) # with parens
38 $VARNAME_REGEXP # without parens
41 =[^=~] # = but not ==, nor =~
47 my $filename = File::Spec->rel2abs( shift );
48 return undef unless defined( $filename ) && -f $filename;
49 return $package->_init( undef, $filename, @_ );
56 $props{inc} ||= \@INC;
57 my $filename = $package->find_module_by_name( $module, $props{inc} );
58 return undef unless defined( $filename ) && -f $filename;
59 return $package->_init( $module, $filename, %props );
68 my( %valid_props, @valid_props );
69 @valid_props = qw( collect_pod inc );
70 @valid_props{@valid_props} = delete( @props{@valid_props} );
71 warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
75 filename => $filename,
86 my $self = bless( \%data, $package );
90 unless ( $self->{module} && length( $self->{module} ) ) {
91 my( $v, $d, $f ) = File::Spec->splitpath( $self->{filename} );
92 if ( $f =~ /\.pm$/ ) {
94 my @candidates = grep /$f$/, @{$self->{packages}};
95 $self->{module} = shift( @candidates ); # punt
97 if ( grep /main/, @{$self->{packages}} ) {
98 $self->{module} = 'main';
100 $self->{module} = $self->{packages}[0] || '';
105 $self->{version} = $self->{versions}{$self->{module}}
106 if defined( $self->{module} );
112 sub _do_find_module {
114 my $module = shift || die 'find_module_by_name() requires a package name';
115 my $dirs = shift || \@INC;
117 my $file = File::Spec->catfile(split( /::/, $module));
118 foreach my $dir ( @$dirs ) {
119 my $testfile = File::Spec->catfile($dir, $file);
120 return [ File::Spec->rel2abs( $testfile ), $dir ]
121 if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
122 return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
123 if -e "$testfile.pm";
129 sub find_module_by_name {
130 my $found = shift()->_do_find_module(@_) or return;
135 sub find_module_dir_by_name {
136 my $found = shift()->_do_find_module(@_) or return;
141 # given a line of perl code, attempt to parse it if it looks like a
142 # $VERSION assignment, returning sigil, full name, & package name
143 sub _parse_version_expression {
147 my( $sig, $var, $pkg );
148 if ( $line =~ $VERS_REGEXP ) {
149 ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
151 $pkg = ($pkg eq '::') ? 'main' : $pkg;
156 return ( $sig, $var, $pkg );
162 my $filename = $self->{filename};
163 my $fh = IO::File->new( $filename )
164 or die( "Can't open '$filename': $!" );
166 $self->_parse_fh($fh);
170 my ($self, $fh) = @_;
172 my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
173 my( @pkgs, %vers, %pod, @pod );
178 while (defined( my $line = <$fh> )) {
181 next if $line =~ /^\s*#/;
183 $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
185 # Would be nice if we could also check $in_string or something too
186 last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
188 if ( $in_pod || $line =~ /^=cut/ ) {
190 if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
192 if ( $self->{collect_pod} && length( $pod_data ) ) {
193 $pod{$pod_sect} = $pod_data;
199 } elsif ( $self->{collect_pod} ) {
200 $pod_data .= "$line\n";
209 # parse $line to see if it's a $VERSION declaration
210 my( $vers_sig, $vers_fullname, $vers_pkg ) =
211 $self->_parse_version_expression( $line );
213 if ( $line =~ $PKG_REGEXP ) {
215 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
216 $vers{$pkg} = undef unless exists( $vers{$pkg} );
219 # VERSION defined with full package spec, i.e. $Module::VERSION
220 } elsif ( $vers_fullname && $vers_pkg ) {
221 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
222 $need_vers = 0 if $vers_pkg eq $pkg;
224 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
226 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
228 # Warn unless the user is using the "$VERSION = eval
229 # $VERSION" idiom (though there are probably other idioms
230 # that we should watch out for...)
231 warn <<"EOM" unless $line =~ /=\s*eval/;
232 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
233 ignoring subsequent declaration.
237 # first non-comment line in undeclared package main is VERSION
238 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
241 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
243 push( @pkgs, 'main' );
245 # first non-comement line in undeclared packge defines package main
246 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
249 push( @pkgs, 'main' );
251 # only keep if this is the first $VERSION seen
252 } elsif ( $vers_fullname && $need_vers ) {
255 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
258 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
262 Package '$pkg' already declared with version '$vers{$pkg}'
263 ignoring new version '$v'.
273 if ( $self->{collect_pod} && length($pod_data) ) {
274 $pod{$pod_sect} = $pod_data;
277 $self->{versions} = \%vers;
278 $self->{packages} = \@pkgs;
279 $self->{pod} = \%pod;
280 $self->{pod_headings} = \@pod;
283 sub _evaluate_version_line {
285 my( $sigil, $var, $line ) = @_;
287 # Some of this code came from the ExtUtils:: hierarchy.
289 my $eval = qq{q# Hide from _packages_inside()
290 #; package Module::Build::ModuleInfo::_version;
300 # Try and get the $VERSION
301 my $result = eval $eval;
302 warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;
304 # Bless it into our own version class
305 $result = Module::Build::Version->new($result);
311 ############################################################
314 sub name { $_[0]->{module} }
316 sub filename { $_[0]->{filename} }
317 sub packages_inside { @{$_[0]->{packages}} }
318 sub pod_inside { @{$_[0]->{pod_headings}} }
319 sub contains_pod { $#{$_[0]->{pod_headings}} }
323 my $mod = shift || $self->{module};
325 if ( defined( $mod ) && length( $mod ) &&
326 exists( $self->{versions}{$mod} ) ) {
327 return $self->{versions}{$mod};
336 if ( defined( $sect ) && length( $sect ) &&
337 exists( $self->{pod}{$sect} ) ) {
338 return $self->{pod}{$sect};
350 ModuleInfo - Gather package and POD information from a perl module files
357 =item new_from_file($filename, collect_pod => 1)
359 Construct a ModuleInfo object given the path to a file. Takes an optional
360 arguement C<collect_pod> which is a boolean that determines whether
361 POD data is collected and stored for reference. POD data is not
362 collected by default. POD headings are always collected.
364 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
366 Construct a ModuleInfo object given a module or package name. In addition
367 to accepting the C<collect_pod> argument as described above, this
368 method accepts a C<inc> arguemnt which is a reference to an array of
369 of directories to search for the module. If none are given, the
374 Returns the name of the package represented by this module. If there
375 are more than one packages, it makes a best guess based on the
376 filename. If it's a script (i.e. not a *.pm) the package name is
379 =item version($package)
381 Returns the version as defined by the $VERSION variable for the
382 package as returned by the C<name> method if no arguments are
383 given. If given the name of a package it will attempt to return the
384 version of that package if it is specified in the file.
388 Returns the absolute path to the file.
390 =item packages_inside()
392 Returns a list of packages.
396 Returns a list of POD sections.
400 Returns true if there is any POD in the file.
404 Returns the POD data in the given section.
406 =item find_module_by_name($module, \@dirs)
408 Returns the path to a module given the module or package name. A list
409 of directories can be passed in as an optional paramater, otherwise
412 Can be called as either an object or a class method.
414 =item find_module_dir_by_name($module, \@dirs)
416 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
417 the module C<$module>. A list of directories can be passed in as an
418 optional paramater, otherwise @INC is searched.
420 Can be called as either an object or a class method.
427 Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
432 Copyright (c) 2001-2006 Ken Williams. All rights reserved.
434 This library is free software; you can redistribute it and/or
435 modify it under the same terms as Perl itself.
440 perl(1), L<Module::Build>(3)