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).
9 $VERSION = '0.2808_01';
10 $VERSION = eval $VERSION;
14 use Module::Build::Version;
17 my $PKG_REGEXP = qr/ # match a package declaration
18 ^[\s\{;]* # intro chars on a line
19 package # the word 'package'
21 ([\w:]+) # a package name
22 \s* # optional whitespace
23 ; # semicolon line terminator
26 my $VARNAME_REGEXP = qr/ # match fully-qualified VERSION name
27 ([\$*]) # sigil - $ or *
29 ( # optional leading package name
30 (?:::|\')? # possibly starting like just :: (ala $::VERSION)
31 (?:\w+(?:::|\'))* # Foo::Bar:: ...
37 my $VERS_REGEXP = qr/ # match a VERSION definition
39 \(\s*$VARNAME_REGEXP\s*\) # with parens
41 $VARNAME_REGEXP # without parens
44 =[^=~] # = but not ==, nor =~
50 my $filename = File::Spec->rel2abs( shift );
51 return undef unless defined( $filename ) && -f $filename;
52 return $package->_init( undef, $filename, @_ );
59 $props{inc} ||= \@INC;
60 my $filename = $package->find_module_by_name( $module, $props{inc} );
61 return undef unless defined( $filename ) && -f $filename;
62 return $package->_init( $module, $filename, %props );
71 my( %valid_props, @valid_props );
72 @valid_props = qw( collect_pod inc );
73 @valid_props{@valid_props} = delete( @props{@valid_props} );
74 warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
78 filename => $filename,
89 my $self = bless( \%data, $package );
93 unless ( $self->{module} && length( $self->{module} ) ) {
94 my( $v, $d, $f ) = File::Spec->splitpath( $self->{filename} );
95 if ( $f =~ /\.pm$/ ) {
97 my @candidates = grep /$f$/, @{$self->{packages}};
98 $self->{module} = shift( @candidates ); # punt
100 if ( grep /main/, @{$self->{packages}} ) {
101 $self->{module} = 'main';
103 $self->{module} = $self->{packages}[0] || '';
108 $self->{version} = $self->{versions}{$self->{module}}
109 if defined( $self->{module} );
115 sub _do_find_module {
117 my $module = shift || die 'find_module_by_name() requires a package name';
118 my $dirs = shift || \@INC;
120 my $file = File::Spec->catfile(split( /::/, $module));
121 foreach my $dir ( @$dirs ) {
122 my $testfile = File::Spec->catfile($dir, $file);
123 return [ File::Spec->rel2abs( $testfile ), $dir ]
124 if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
125 return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
126 if -e "$testfile.pm";
132 sub find_module_by_name {
133 my $found = shift()->_do_find_module(@_) or return;
138 sub find_module_dir_by_name {
139 my $found = shift()->_do_find_module(@_) or return;
144 # given a line of perl code, attempt to parse it if it looks like a
145 # $VERSION assignment, returning sigil, full name, & package name
146 sub _parse_version_expression {
150 my( $sig, $var, $pkg );
151 if ( $line =~ $VERS_REGEXP ) {
152 ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
154 $pkg = ($pkg eq '::') ? 'main' : $pkg;
159 return ( $sig, $var, $pkg );
165 my $filename = $self->{filename};
166 my $fh = IO::File->new( $filename )
167 or die( "Can't open '$filename': $!" );
169 $self->_parse_fh($fh);
173 my ($self, $fh) = @_;
175 my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
176 my( @pkgs, %vers, %pod, @pod );
181 while (defined( my $line = <$fh> )) {
184 next if $line =~ /^\s*#/;
186 $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
188 # Would be nice if we could also check $in_string or something too
189 last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
191 if ( $in_pod || $line =~ /^=cut/ ) {
193 if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
195 if ( $self->{collect_pod} && length( $pod_data ) ) {
196 $pod{$pod_sect} = $pod_data;
202 } elsif ( $self->{collect_pod} ) {
203 $pod_data .= "$line\n";
212 # parse $line to see if it's a $VERSION declaration
213 my( $vers_sig, $vers_fullname, $vers_pkg ) =
214 $self->_parse_version_expression( $line );
216 if ( $line =~ $PKG_REGEXP ) {
218 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
219 $vers{$pkg} = undef unless exists( $vers{$pkg} );
222 # VERSION defined with full package spec, i.e. $Module::VERSION
223 } elsif ( $vers_fullname && $vers_pkg ) {
224 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
225 $need_vers = 0 if $vers_pkg eq $pkg;
227 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
229 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
231 # Warn unless the user is using the "$VERSION = eval
232 # $VERSION" idiom (though there are probably other idioms
233 # that we should watch out for...)
234 warn <<"EOM" unless $line =~ /=\s*eval/;
235 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
236 ignoring subsequent declaration.
240 # first non-comment line in undeclared package main is VERSION
241 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
244 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
246 push( @pkgs, 'main' );
248 # first non-comement line in undeclared packge defines package main
249 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
252 push( @pkgs, 'main' );
254 # only keep if this is the first $VERSION seen
255 } elsif ( $vers_fullname && $need_vers ) {
258 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
261 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
265 Package '$pkg' already declared with version '$vers{$pkg}'
266 ignoring new version '$v'.
276 if ( $self->{collect_pod} && length($pod_data) ) {
277 $pod{$pod_sect} = $pod_data;
280 $self->{versions} = \%vers;
281 $self->{packages} = \@pkgs;
282 $self->{pod} = \%pod;
283 $self->{pod_headings} = \@pod;
286 sub _evaluate_version_line {
288 my( $sigil, $var, $line ) = @_;
290 # Some of this code came from the ExtUtils:: hierarchy.
292 # We compile into $vsub because 'use version' would cause
293 # compiletime/runtime issues with local()
295 my $eval = qq{BEGIN { q# Hide from _packages_inside()
296 #; package Module::Build::ModuleInfo::_version;
308 # Try to get the $VERSION
310 warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
312 (ref($vsub) eq 'CODE') or
313 die "failed to build version sub for $self->{filename}";
314 my $result = $vsub->();
316 # Bless it into our own version class
317 $result = Module::Build::Version->new($result);
323 ############################################################
326 sub name { $_[0]->{module} }
328 sub filename { $_[0]->{filename} }
329 sub packages_inside { @{$_[0]->{packages}} }
330 sub pod_inside { @{$_[0]->{pod_headings}} }
331 sub contains_pod { $#{$_[0]->{pod_headings}} }
335 my $mod = shift || $self->{module};
337 if ( defined( $mod ) && length( $mod ) &&
338 exists( $self->{versions}{$mod} ) ) {
339 return $self->{versions}{$mod};
348 if ( defined( $sect ) && length( $sect ) &&
349 exists( $self->{pod}{$sect} ) ) {
350 return $self->{pod}{$sect};
362 ModuleInfo - Gather package and POD information from a perl module files
369 =item new_from_file($filename, collect_pod => 1)
371 Construct a ModuleInfo object given the path to a file. Takes an optional
372 arguement C<collect_pod> which is a boolean that determines whether
373 POD data is collected and stored for reference. POD data is not
374 collected by default. POD headings are always collected.
376 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
378 Construct a ModuleInfo object given a module or package name. In addition
379 to accepting the C<collect_pod> argument as described above, this
380 method accepts a C<inc> arguemnt which is a reference to an array of
381 of directories to search for the module. If none are given, the
386 Returns the name of the package represented by this module. If there
387 are more than one packages, it makes a best guess based on the
388 filename. If it's a script (i.e. not a *.pm) the package name is
391 =item version($package)
393 Returns the version as defined by the $VERSION variable for the
394 package as returned by the C<name> method if no arguments are
395 given. If given the name of a package it will attempt to return the
396 version of that package if it is specified in the file.
400 Returns the absolute path to the file.
402 =item packages_inside()
404 Returns a list of packages.
408 Returns a list of POD sections.
412 Returns true if there is any POD in the file.
416 Returns the POD data in the given section.
418 =item find_module_by_name($module, \@dirs)
420 Returns the path to a module given the module or package name. A list
421 of directories can be passed in as an optional paramater, otherwise
424 Can be called as either an object or a class method.
426 =item find_module_dir_by_name($module, \@dirs)
428 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
429 the module C<$module>. A list of directories can be passed in as an
430 optional paramater, otherwise @INC is searched.
432 Can be called as either an object or a class method.
439 Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
444 Copyright (c) 2001-2006 Ken Williams. All rights reserved.
446 This library is free software; you can redistribute it and/or
447 modify it under the same terms as Perl itself.
452 perl(1), L<Module::Build>(3)