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).
13 my $PKG_REGEXP = qr/ # match a package declaration
14 ^[\s\{;]* # intro chars on a line
15 package # the word 'package'
17 ([\w:]+) # a package name
18 \s* # optional whitespace
19 ; # semicolon line terminator
22 my $VARNAME_REGEXP = qr/ # match fully-qualified VERSION name
23 ([\$*]) # sigil - $ or *
25 ( # optional leading package name
26 (?:::|\')? # possibly starting like just :: (ala $::VERSION)
27 (?:\w+(?:::|\'))* # Foo::Bar:: ...
33 my $VERS_REGEXP = qr/ # match a VERSION definition
35 \(\s*$VARNAME_REGEXP\s*\) # with parens
37 $VARNAME_REGEXP # without parens
40 =[^=~] # = but not ==, nor =~
46 my $filename = File::Spec->rel2abs( shift );
47 return undef unless defined( $filename ) && -f $filename;
48 return $package->_init( undef, $filename, @_ );
55 $props{inc} ||= \@INC;
56 my $filename = $package->find_module_by_name( $module, $props{inc} );
57 return undef unless defined( $filename ) && -f $filename;
58 return $package->_init( $module, $filename, %props );
67 my( %valid_props, @valid_props );
68 @valid_props = qw( collect_pod inc );
69 @valid_props{@valid_props} = delete( @props{@valid_props} );
70 warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
74 filename => $filename,
85 my $self = bless( \%data, $package );
89 unless ( $self->{module} && length( $self->{module} ) ) {
90 my( $v, $d, $f ) = File::Spec->splitpath( $self->{filename} );
91 if ( $f =~ /\.pm$/ ) {
93 my @candidates = grep /$f$/, @{$self->{packages}};
94 $self->{module} = shift( @candidates ); # punt
96 if ( grep /main/, @{$self->{packages}} ) {
97 $self->{module} = 'main';
99 $self->{module} = $self->{packages}[0] || '';
104 $self->{version} = $self->{versions}{$self->{module}}
105 if defined( $self->{module} );
111 sub _do_find_module {
113 my $module = shift || die 'find_module_by_name() requires a package name';
114 my $dirs = shift || \@INC;
116 my $file = File::Spec->catfile(split( /::/, $module));
117 foreach my $dir ( @$dirs ) {
118 my $testfile = File::Spec->catfile($dir, $file);
119 return [ File::Spec->rel2abs( $testfile ), $dir ]
120 if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
121 return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
122 if -e "$testfile.pm";
128 sub find_module_by_name {
129 my $found = shift()->_do_find_module(@_) or return;
134 sub find_module_dir_by_name {
135 my $found = shift()->_do_find_module(@_) or return;
140 # given a line of perl code, attempt to parse it if it looks like a
141 # $VERSION assignment, returning sigil, full name, & package name
142 sub _parse_version_expression {
146 my( $sig, $var, $pkg );
147 if ( $line =~ $VERS_REGEXP ) {
148 ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
150 $pkg = ($pkg eq '::') ? 'main' : $pkg;
155 return ( $sig, $var, $pkg );
161 my $filename = $self->{filename};
162 my $fh = IO::File->new( $filename )
163 or die( "Can't open '$filename': $!" );
165 my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
166 my( @pkgs, %vers, %pod, @pod );
171 while (defined( my $line = <$fh> )) {
174 next if $line =~ /^\s*#/;
176 $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
178 if ( $in_pod || $line =~ /^=cut/ ) {
180 if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
182 if ( $self->{collect_pod} && length( $pod_data ) ) {
183 $pod{$pod_sect} = $pod_data;
189 } elsif ( $self->{collect_pod} ) {
190 $pod_data .= "$line\n";
199 # parse $line to see if it's a $VERSION declaration
200 my( $vers_sig, $vers_fullname, $vers_pkg ) =
201 $self->_parse_version_expression( $line );
203 if ( $line =~ $PKG_REGEXP ) {
205 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
206 $vers{$pkg} = undef unless exists( $vers{$pkg} );
209 # VERSION defined with full package spec, i.e. $Module::VERSION
210 } elsif ( $vers_fullname && $vers_pkg ) {
211 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
212 $need_vers = 0 if $vers_pkg eq $pkg;
215 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
216 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
217 $vers{$vers_pkg} = $v;
220 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}'
221 ignoring new version '$v'.
225 # first non-comment line in undeclared package main is VERSION
226 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
229 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
231 push( @pkgs, 'main' );
233 # first non-comement line in undeclared packge defines package main
234 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
237 push( @pkgs, 'main' );
239 # only keep if this is the first $VERSION seen
240 } elsif ( $vers_fullname && $need_vers ) {
243 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
246 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
250 Package '$pkg' already declared with version '$vers{$pkg}'
251 ignoring new version '$v'.
261 if ( $self->{collect_pod} && length($pod_data) ) {
262 $pod{$pod_sect} = $pod_data;
265 $self->{versions} = \%vers;
266 $self->{packages} = \@pkgs;
267 $self->{pod} = \%pod;
268 $self->{pod_headings} = \@pod;
271 sub _evaluate_version_line {
273 my( $sigil, $var, $line ) = @_;
275 # Some of this code came from the ExtUtils:: hierarchy.
277 my $eval = qq{q# Hide from _packages_inside()
278 #; package Module::Build::ModuleInfo::_version;
288 # version.pm will change the ->VERSION method, so we mitigate the
289 # potential effects here. Unfortunately local(*UNIVERSAL::VERSION)
290 # will crash perl < 5.8.1. We also use * Foo::VERSION instead of
291 # *Foo::VERSION so that old versions of CPAN.pm, etc. with a
292 # too-permissive regex don't think we're actually declaring a
295 my $old_version = \&UNIVERSAL::VERSION;
296 eval {require version};
297 my $result = eval $eval;
298 * UNIVERSAL::VERSION = $old_version;
299 warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;
301 # Unbless it if it's a version.pm object
302 $result = $result->numify if UNIVERSAL::isa($result, 'version');
308 ############################################################
311 sub name { $_[0]->{module} }
313 sub filename { $_[0]->{filename} }
314 sub packages_inside { @{$_[0]->{packages}} }
315 sub pod_inside { @{$_[0]->{pod_headings}} }
316 sub contains_pod { $#{$_[0]->{pod_headings}} }
320 my $mod = shift || $self->{module};
322 if ( defined( $mod ) && length( $mod ) &&
323 exists( $self->{versions}{$mod} ) ) {
324 return $self->{versions}{$mod};
333 if ( defined( $sect ) && length( $sect ) &&
334 exists( $self->{pod}{$sect} ) ) {
335 return $self->{pod}{$sect};
347 ModuleInfo - Gather package and POD information from a perl module files
354 =item new_from_file($filename, collect_pod => 1)
356 Construct a ModuleInfo object given the path to a file. Takes an optional
357 arguement C<collect_pod> which is a boolean that determines whether
358 POD data is collected and stored for reference. POD data is not
359 collected by default. POD headings are always collected.
361 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
363 Construct a ModuleInfo object given a module or package name. In addition
364 to accepting the C<collect_pod> argument as described above, this
365 method accepts a C<inc> arguemnt which is a reference to an array of
366 of directories to search for the module. If none are given, the
371 Returns the name of the package represented by this module. If there
372 are more than one packages, it makes a best guess based on the
373 filename. If it's a script (i.e. not a *.pm) the package name is
376 =item version($package)
378 Returns the version as defined by the $VERSION variable for the
379 package as returned by the C<name> method if no arguments are
380 given. If given the name of a package it will attempt to return the
381 version of that package if it is specified in the file.
385 Returns the absolute path to the file.
387 =item packages_inside()
389 Returns a list of packages.
393 Returns a list of POD sections.
397 Returns true if there is any POD in the file.
401 Returns the POD data in the given section.
403 =item find_module_by_name($module, \@dirs)
405 Returns the path to a module given the module or package name. A list
406 of directories can be passed in as an optional paramater, otherwise
409 Can be called as either an object or a class method.
411 =item find_module_dir_by_name($module, \@dirs)
413 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
414 the module C<$module>. A list of directories can be passed in as an
415 optional paramater, otherwise @INC is searched.
417 Can be called as either an object or a class method.
424 Ken Williams <ken@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
429 Copyright (c) 2001-2005 Ken Williams. All rights reserved.
431 This library is free software; you can redistribute it and/or
432 modify it under the same terms as Perl itself.
437 perl(1), L<Module::Build>(3)