1 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
2 # vim:ts=8:sw=2:et:sta:sts=2
3 package Module::Build::ModuleInfo;
5 # This module provides routines to gather information about
6 # perl modules (assuming this may be expanded in the distant
7 # parrot future to look at other types of modules).
10 use vars qw($VERSION);
12 $VERSION = eval $VERSION;
16 use Module::Build::Version;
19 my $PKG_REGEXP = qr{ # match a package declaration
20 ^[\s\{;]* # intro chars on a line
21 package # the word 'package'
23 ([\w:]+) # a package name
24 \s* # optional whitespace
25 ; # semicolon line terminator
28 my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name
29 ([\$*]) # sigil - $ or *
31 ( # optional leading package name
32 (?:::|\')? # possibly starting like just :: (Ì la $::VERSION)
33 (?:\w+(?:::|\'))* # Foo::Bar:: ...
39 my $VERS_REGEXP = qr{ # match a VERSION definition
41 \(\s*$VARNAME_REGEXP\s*\) # with parens
43 $VARNAME_REGEXP # without parens
46 =[^=~] # = but not ==, nor =~
52 my $filename = File::Spec->rel2abs( shift );
54 return undef unless defined( $filename ) && -f $filename;
55 return $class->_init(undef, $filename, @_);
63 $props{inc} ||= \@INC;
64 my $filename = $class->find_module_by_name( $module, $props{inc} );
65 return undef unless defined( $filename ) && -f $filename;
66 return $class->_init($module, $filename, %props);
75 my( %valid_props, @valid_props );
76 @valid_props = qw( collect_pod inc );
77 @valid_props{@valid_props} = delete( @props{@valid_props} );
78 warn "Unknown properties: @{[keys %props]}\n" if scalar( %props );
82 filename => $filename,
93 my $self = bless(\%data, $class);
97 unless($self->{module} and length($self->{module})) {
98 my ($v, $d, $f) = File::Spec->splitpath($self->{filename});
101 my @candidates = grep /$f$/, @{$self->{packages}};
102 $self->{module} = shift(@candidates); # punt
105 if(grep /main/, @{$self->{packages}}) {
106 $self->{module} = 'main';
109 $self->{module} = $self->{packages}[0] || '';
114 $self->{version} = $self->{versions}{$self->{module}}
115 if defined( $self->{module} );
121 sub _do_find_module {
123 my $module = shift || die 'find_module_by_name() requires a package name';
124 my $dirs = shift || \@INC;
126 my $file = File::Spec->catfile(split( /::/, $module));
127 foreach my $dir ( @$dirs ) {
128 my $testfile = File::Spec->catfile($dir, $file);
129 return [ File::Spec->rel2abs( $testfile ), $dir ]
130 if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp
131 return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ]
132 if -e "$testfile.pm";
138 sub find_module_by_name {
139 my $found = shift()->_do_find_module(@_) or return;
144 sub find_module_dir_by_name {
145 my $found = shift()->_do_find_module(@_) or return;
150 # given a line of perl code, attempt to parse it if it looks like a
151 # $VERSION assignment, returning sigil, full name, & package name
152 sub _parse_version_expression {
156 my( $sig, $var, $pkg );
157 if ( $line =~ $VERS_REGEXP ) {
158 ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 );
160 $pkg = ($pkg eq '::') ? 'main' : $pkg;
165 return ( $sig, $var, $pkg );
171 my $filename = $self->{filename};
172 my $fh = IO::File->new( $filename )
173 or die( "Can't open '$filename': $!" );
175 $self->_parse_fh($fh);
179 my ($self, $fh) = @_;
181 my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 );
182 my( @pkgs, %vers, %pod, @pod );
187 while (defined( my $line = <$fh> )) {
191 next if $line =~ /^\s*#/;
193 $in_pod = ($line =~ /^=(?!cut)/) ? 1 : ($line =~ /^=cut/) ? 0 : $in_pod;
195 # Would be nice if we could also check $in_string or something too
196 last if !$in_pod && $line =~ /^__(?:DATA|END)__$/;
198 if ( $in_pod || $line =~ /^=cut/ ) {
200 if ( $line =~ /^=head\d\s+(.+)\s*$/ ) {
202 if ( $self->{collect_pod} && length( $pod_data ) ) {
203 $pod{$pod_sect} = $pod_data;
209 } elsif ( $self->{collect_pod} ) {
210 $pod_data .= "$line\n";
219 # parse $line to see if it's a $VERSION declaration
220 my( $vers_sig, $vers_fullname, $vers_pkg ) =
221 $self->_parse_version_expression( $line );
223 if ( $line =~ $PKG_REGEXP ) {
225 push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs );
226 $vers{$pkg} = undef unless exists( $vers{$pkg} );
229 # VERSION defined with full package spec, i.e. $Module::VERSION
230 } elsif ( $vers_fullname && $vers_pkg ) {
231 push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs );
232 $need_vers = 0 if $vers_pkg eq $pkg;
234 unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) {
236 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
238 # Warn unless the user is using the "$VERSION = eval
239 # $VERSION" idiom (though there are probably other idioms
240 # that we should watch out for...)
241 warn <<"EOM" unless $line =~ /=\s*eval/;
242 Package '$vers_pkg' already declared with version '$vers{$vers_pkg}',
243 ignoring subsequent declaration on line $line_num.
247 # first non-comment line in undeclared package main is VERSION
248 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) {
251 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
253 push( @pkgs, 'main' );
255 # first non-comment line in undeclared package defines package main
256 } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) {
259 push( @pkgs, 'main' );
261 # only keep if this is the first $VERSION seen
262 } elsif ( $vers_fullname && $need_vers ) {
265 $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line );
268 unless ( defined $vers{$pkg} && length $vers{$pkg} ) {
272 Package '$pkg' already declared with version '$vers{$pkg}'
273 ignoring new version '$v' on line $line_num.
283 if ( $self->{collect_pod} && length($pod_data) ) {
284 $pod{$pod_sect} = $pod_data;
287 $self->{versions} = \%vers;
288 $self->{packages} = \@pkgs;
289 $self->{pod} = \%pod;
290 $self->{pod_headings} = \@pod;
295 sub _evaluate_version_line {
297 my( $sigil, $var, $line ) = @_;
299 # Some of this code came from the ExtUtils:: hierarchy.
301 # We compile into $vsub because 'use version' would cause
302 # compiletime/runtime issues with local()
304 $pn++; # everybody gets their own package
305 my $eval = qq{BEGIN { q# Hide from _packages_inside()
306 #; package Module::Build::ModuleInfo::_version::p$pn;
307 use Module::Build::Version;
319 # Try to get the $VERSION
321 warn "Error evaling version line '$eval' in $self->{filename}: $@\n"
323 (ref($vsub) eq 'CODE') or
324 die "failed to build version sub for $self->{filename}";
325 my $result = eval { $vsub->() };
327 die "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@;
329 # Bless it into our own version class
330 $result = Module::Build::Version->new($result);
337 ############################################################
340 sub name { $_[0]->{module} }
342 sub filename { $_[0]->{filename} }
343 sub packages_inside { @{$_[0]->{packages}} }
344 sub pod_inside { @{$_[0]->{pod_headings}} }
345 sub contains_pod { $#{$_[0]->{pod_headings}} }
349 my $mod = shift || $self->{module};
351 if ( defined( $mod ) && length( $mod ) &&
352 exists( $self->{versions}{$mod} ) ) {
353 return $self->{versions}{$mod};
362 if ( defined( $sect ) && length( $sect ) &&
363 exists( $self->{pod}{$sect} ) ) {
364 return $self->{pod}{$sect};
374 =for :stopwords ModuleInfo
378 ModuleInfo - Gather package and POD information from a perl module file
385 =item new_from_file($filename, collect_pod => 1)
387 Construct a C<ModuleInfo> object given the path to a file. Takes an optional
388 argument C<collect_pod> which is a boolean that determines whether
389 POD data is collected and stored for reference. POD data is not
390 collected by default. POD headings are always collected.
392 =item new_from_module($module, collect_pod => 1, inc => \@dirs)
394 Construct a C<ModuleInfo> object given a module or package name. In addition
395 to accepting the C<collect_pod> argument as described above, this
396 method accepts a C<inc> argument which is a reference to an array of
397 of directories to search for the module. If none are given, the
402 Returns the name of the package represented by this module. If there
403 are more than one packages, it makes a best guess based on the
404 filename. If it's a script (i.e. not a *.pm) the package name is
407 =item version($package)
409 Returns the version as defined by the $VERSION variable for the
410 package as returned by the C<name> method if no arguments are
411 given. If given the name of a package it will attempt to return the
412 version of that package if it is specified in the file.
416 Returns the absolute path to the file.
418 =item packages_inside()
420 Returns a list of packages.
424 Returns a list of POD sections.
428 Returns true if there is any POD in the file.
432 Returns the POD data in the given section.
434 =item find_module_by_name($module, \@dirs)
436 Returns the path to a module given the module or package name. A list
437 of directories can be passed in as an optional parameter, otherwise
440 Can be called as either an object or a class method.
442 =item find_module_dir_by_name($module, \@dirs)
444 Returns the entry in C<@dirs> (or C<@INC> by default) that contains
445 the module C<$module>. A list of directories can be passed in as an
446 optional parameter, otherwise @INC is searched.
448 Can be called as either an object or a class method.
455 Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
460 Copyright (c) 2001-2006 Ken Williams. All rights reserved.
462 This library is free software; you can redistribute it and/or
463 modify it under the same terms as Perl itself.
468 perl(1), L<Module::Build>(3)