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 my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
167 my( @pkgs, %vers, %pod, @pod );
172 while (defined( my $line = <$fh> )) {
175 next if $line =~ /^\s*#/;
177 $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
179 if ( $in_pod || $line =~ /^=cut/ ) {
181 if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
183 if ( $self->{collect_pod} && length( $pod_data ) ) {
184 $pod{$pod_sect} = $pod_data;
190 } elsif ( $self->{collect_pod} ) {
191 $pod_data .= "$line\n";
200 # parse $line to see if it's a $VERSION declaration
201 my( $vers_sig, $vers_fullname, $vers_pkg ) =
202 $self->_parse_version_expression( $line );
204 if ( $line =~ $PKG_REGEXP ) {
206 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
207 $vers{$pkg} = undef unless exists( $vers{$pkg} );
210 # VERSION defined with full package spec, i.e. $Module::VERSION
211 } elsif ( $vers_fullname && $vers_pkg ) {
212 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
213 $need_vers = 0 if $vers_pkg eq $pkg;
216 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
217 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
218 $vers{$vers_pkg} = $v;
221 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}'
222 ignoring new version '$v'.
226 # first non-comment line in undeclared package main is VERSION
227 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
230 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
232 push( @pkgs, 'main' );
234 # first non-comement line in undeclared packge defines package main
235 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
238 push( @pkgs, 'main' );
240 # only keep if this is the first $VERSION seen
241 } elsif ( $vers_fullname && $need_vers ) {
244 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
247 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
251 Package '$pkg' already declared with version '$vers{$pkg}'
252 ignoring new version '$v'.
262 if ( $self->{collect_pod} && length($pod_data) ) {
263 $pod{$pod_sect} = $pod_data;
266 $self->{versions} = \%vers;
267 $self->{packages} = \@pkgs;
268 $self->{pod} = \%pod;
269 $self->{pod_headings} = \@pod;
272 sub _evaluate_version_line {
274 my( $sigil, $var, $line ) = @_;
276 # Some of this code came from the ExtUtils:: hierarchy.
278 my $eval = qq{q# Hide from _packages_inside()
279 #; package Module::Build::ModuleInfo::_version;
289 # Try and get the $VERSION
290 my $result = eval $eval;
291 warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;
293 # Bless it into our own version class
294 $result = Module::Build::Version->new($result);
300 ############################################################
303 sub name { $_[0]->{module} }
305 sub filename { $_[0]->{filename} }
306 sub packages_inside { @{$_[0]->{packages}} }
307 sub pod_inside { @{$_[0]->{pod_headings}} }
308 sub contains_pod { $#{$_[0]->{pod_headings}} }
312 my $mod = shift || $self->{module};
314 if ( defined( $mod ) && length( $mod ) &&
315 exists( $self->{versions}{$mod} ) ) {
316 return $self->{versions}{$mod};
325 if ( defined( $sect ) && length( $sect ) &&
326 exists( $self->{pod}{$sect} ) ) {
327 return $self->{pod}{$sect};
339 ModuleInfo - Gather package and POD information from a perl module files
346 =item new_from_file($filename, collect_pod => 1)
348 Construct a ModuleInfo object given the path to a file. Takes an optional
349 arguement C<collect_pod> which is a boolean that determines whether
350 POD data is collected and stored for reference. POD data is not
351 collected by default. POD headings are always collected.
353 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
355 Construct a ModuleInfo object given a module or package name. In addition
356 to accepting the C<collect_pod> argument as described above, this
357 method accepts a C<inc> arguemnt which is a reference to an array of
358 of directories to search for the module. If none are given, the
363 Returns the name of the package represented by this module. If there
364 are more than one packages, it makes a best guess based on the
365 filename. If it's a script (i.e. not a *.pm) the package name is
368 =item version($package)
370 Returns the version as defined by the $VERSION variable for the
371 package as returned by the C<name> method if no arguments are
372 given. If given the name of a package it will attempt to return the
373 version of that package if it is specified in the file.
377 Returns the absolute path to the file.
379 =item packages_inside()
381 Returns a list of packages.
385 Returns a list of POD sections.
389 Returns true if there is any POD in the file.
393 Returns the POD data in the given section.
395 =item find_module_by_name($module, \@dirs)
397 Returns the path to a module given the module or package name. A list
398 of directories can be passed in as an optional paramater, otherwise
401 Can be called as either an object or a class method.
403 =item find_module_dir_by_name($module, \@dirs)
405 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
406 the module C<$module>. A list of directories can be passed in as an
407 optional paramater, otherwise @INC is searched.
409 Can be called as either an object or a class method.
416 Ken Williams <ken@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
421 Copyright (c) 2001-2005 Ken Williams. All rights reserved.
423 This library is free software; you can redistribute it and/or
424 modify it under the same terms as Perl itself.
429 perl(1), L<Module::Build>(3)