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 # Would be nice if we could also check $in_string or something too
180 last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
182 if ( $in_pod || $line =~ /^=cut/ ) {
184 if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
186 if ( $self->{collect_pod} && length( $pod_data ) ) {
187 $pod{$pod_sect} = $pod_data;
193 } elsif ( $self->{collect_pod} ) {
194 $pod_data .= "$line\n";
203 # parse $line to see if it's a $VERSION declaration
204 my( $vers_sig, $vers_fullname, $vers_pkg ) =
205 $self->_parse_version_expression( $line );
207 if ( $line =~ $PKG_REGEXP ) {
209 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
210 $vers{$pkg} = undef unless exists( $vers{$pkg} );
213 # VERSION defined with full package spec, i.e. $Module::VERSION
214 } elsif ( $vers_fullname && $vers_pkg ) {
215 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
216 $need_vers = 0 if $vers_pkg eq $pkg;
219 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
220 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
221 $vers{$vers_pkg} = $v;
224 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}'
225 ignoring new version '$v'.
229 # first non-comment line in undeclared package main is VERSION
230 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
233 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
235 push( @pkgs, 'main' );
237 # first non-comement line in undeclared packge defines package main
238 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
241 push( @pkgs, 'main' );
243 # only keep if this is the first $VERSION seen
244 } elsif ( $vers_fullname && $need_vers ) {
247 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
250 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
254 Package '$pkg' already declared with version '$vers{$pkg}'
255 ignoring new version '$v'.
265 if ( $self->{collect_pod} && length($pod_data) ) {
266 $pod{$pod_sect} = $pod_data;
269 $self->{versions} = \%vers;
270 $self->{packages} = \@pkgs;
271 $self->{pod} = \%pod;
272 $self->{pod_headings} = \@pod;
275 sub _evaluate_version_line {
277 my( $sigil, $var, $line ) = @_;
279 # Some of this code came from the ExtUtils:: hierarchy.
281 my $eval = qq{q# Hide from _packages_inside()
282 #; package Module::Build::ModuleInfo::_version;
292 # Try and get the $VERSION
293 my $result = eval $eval;
294 warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@;
296 # Bless it into our own version class
297 $result = Module::Build::Version->new($result);
303 ############################################################
306 sub name { $_[0]->{module} }
308 sub filename { $_[0]->{filename} }
309 sub packages_inside { @{$_[0]->{packages}} }
310 sub pod_inside { @{$_[0]->{pod_headings}} }
311 sub contains_pod { $#{$_[0]->{pod_headings}} }
315 my $mod = shift || $self->{module};
317 if ( defined( $mod ) && length( $mod ) &&
318 exists( $self->{versions}{$mod} ) ) {
319 return $self->{versions}{$mod};
328 if ( defined( $sect ) && length( $sect ) &&
329 exists( $self->{pod}{$sect} ) ) {
330 return $self->{pod}{$sect};
342 ModuleInfo - Gather package and POD information from a perl module files
349 =item new_from_file($filename, collect_pod => 1)
351 Construct a ModuleInfo object given the path to a file. Takes an optional
352 arguement C<collect_pod> which is a boolean that determines whether
353 POD data is collected and stored for reference. POD data is not
354 collected by default. POD headings are always collected.
356 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
358 Construct a ModuleInfo object given a module or package name. In addition
359 to accepting the C<collect_pod> argument as described above, this
360 method accepts a C<inc> arguemnt which is a reference to an array of
361 of directories to search for the module. If none are given, the
366 Returns the name of the package represented by this module. If there
367 are more than one packages, it makes a best guess based on the
368 filename. If it's a script (i.e. not a *.pm) the package name is
371 =item version($package)
373 Returns the version as defined by the $VERSION variable for the
374 package as returned by the C<name> method if no arguments are
375 given. If given the name of a package it will attempt to return the
376 version of that package if it is specified in the file.
380 Returns the absolute path to the file.
382 =item packages_inside()
384 Returns a list of packages.
388 Returns a list of POD sections.
392 Returns true if there is any POD in the file.
396 Returns the POD data in the given section.
398 =item find_module_by_name($module, \@dirs)
400 Returns the path to a module given the module or package name. A list
401 of directories can be passed in as an optional paramater, otherwise
404 Can be called as either an object or a class method.
406 =item find_module_dir_by_name($module, \@dirs)
408 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
409 the module C<$module>. A list of directories can be passed in as an
410 optional paramater, otherwise @INC is searched.
412 Can be called as either an object or a class method.
419 Ken Williams <ken@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
424 Copyright (c) 2001-2005 Ken Williams. All rights reserved.
426 This library is free software; you can redistribute it and/or
427 modify it under the same terms as Perl itself.
432 perl(1), L<Module::Build>(3)