Hello all,
I try to write a program which checks a Perl script for all modules it
needs at runtime.
This step is necessary for a standalone builder where all modules are
put into the TEXT resource of a standalone program. The current
RuntimeBuilder, originally written by Michael Ziege and greatly enhanced
by Keitarou Miyazaki, lacks this ability. Now standalone MacPerl
programs may therefore stop with messages about missing modules.
The task looked not that difficult but as you can see from the code
below it got larger and larger.
The idea is to go through the source file, find its "use" and "require"
lines, eval them and fill %INC. In a second loop I go through every
entry of %INC search for further "require" statements, check if the then
required files containes another "require" and so on and on until %INC
doesn't grow anymore.
You can run the script on Unix too.
I'd like to hear your comments. Corrections are very much welcomed.
Good night,
Axel.
###########################################################################
#!perl -w
### use strict;
### $| = 1;
sub eval_require_line {
my $file = shift;
local *FILE;
open FILE, $file or die "cannot open file '$file'";
my $skip_pod_section = 0;
while( <FILE> ) {
last if /^__END__/;
if( ! $skip_pod_section and /^=/ ) { $skip_pod_section = 1; next; }
if( $skip_pod_section and /^=cut/ ) { $skip_pod_section = 0; next; }
next if $skip_pod_section;
next unless /\brequire\b.+;/;
next if not_understandable();
# tranlsate Unix path
if( /require\s+'*"*\w+\/\w+/ ) { tr/\//:/ }
my $result = m/\brequire\s+([\w:]+)\b(.*)/;
my $new_module;
if( $result ) {
$new_module = $1;
}
else {
warn "regexp for require statement failed while checking '$file'\nline '$_'";
next;
}
my $new_module_key = $new_module.".pm";
$new_module_key =~ s/::/\//g;
next if exists $INC{ $new_module_key };
# fill %INC
my $eval_line = "use $new_module";
eval( $eval_line );
warn "$@ in line '$eval_line'" if $@;
}
close FILE;
}
sub eval_use_line {
my $file = shift;
local *FILE;
open FILE, $file or die "cannot open file '$file'";
my $skip_pod_section = 0;
while( <FILE> ) {
last if /^__END__/; # don't look into pod files...
if( ! $skip_pod_section and /^=/ ) { $skip_pod_section = 1; next; }
if( $skip_pod_section and /^=cut/ ) { $skip_pod_section = 0; next; }
next if $skip_pod_section;
next unless /^\s*use.+;/o; # only "use" statements are interesting
next if /^\s*use\s+constant/o; # avoid annoying messages on some module...
# fill %INC
eval( $_ );
warn "$@ in line '$_'" if $@;
# TODO: what, if "use" statement spans multiple lines ...
}
close FILE;
}
sub recurse_required {
my $file = shift;
my $count_includes = scalar keys %INC;
local *FILE;
open FILE, $file or die "cannot open file '$file'";
my $skip_pod_section = 0;
while( <FILE> ) {
last if /^__END__/;
if( ! $skip_pod_section and /^=/ ) { $skip_pod_section = 1; next; }
if( $skip_pod_section and /^=cut/ ) { $skip_pod_section = 0; next; }
next if $skip_pod_section;
next unless /\brequire\b.+;/;
next if not_understandable();
# tranlsate Unix path
if( /require\s+'*"*\w+\/\w+/ ) { tr/\//:/ }
my $result = m/\brequire\s+'*"*([\w:]+)'*"*\b(.*)/;
my $new_module;
if( $result ) {
$new_module = $1;
}
else {
warn "regexp for require statement failed while checking '$file'\nline '$_'";
next;
}
my $new_module_key = $new_module.".pm";
$new_module_key =~ s/::/\//g;
next if exists $INC{ $new_module_key };
# fill %INC
my $eval_line = "use $new_module";
eval( $eval_line );
warn "$@ in line '$eval_line'" if $@;
=for debug
print "INFO: found \"require\" line in '$file' - evaluated '$eval_line', now ",
scalar keys %INC, " entries in %INC (was: $count_includes)\n";
=cut
if( (scalar keys %INC) > $count_includes ) {
print "INFO: new dependencies found in '$file' - '$new_module'\n";
my $new_module_path = find_module( $new_module );
recurse_required( $new_module_path );
$count_includes = scalar keys %INC;
}
}
close FILE;
}
sub not_understandable {
return 1 if /require\s+\d/; # skip "require <perl-version>"
return 1 if /#\s*require/; # skip comments
return 1 if /require\s+'*"*(\$|.+\/\$)'*"*/; # we cannot know the content of a file
name variable ...
return 1 if /eval.+require/; # ignore modules if exception handling is already
included
return 1 if /\$require/; # keep regexp understandable
# some particular difficult sample lines:
# require IO::Socket::UNIX if ($^O ne 'epoc');
# { local $@; require Carp::Heavy; } # XXX fix require to not clear $@?
# do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
# Carp::croak("$pkg $wanted required--this is only version $version$file")
# ($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
# eval { local $SIG{__DIE__}; require $filename };
# require '$optionRequire{$option}'
# eval "require Term::Rendezvous;" or die;
# require "File/Spec/$module.pm";
return 0;
}
sub find_module {
# try to find module in source script directories or subdirectories of @INC
# a complete different strategy could be to extract the hash value in %INC
# by finding the newly added entry
my $DIRSEP;
$DIRSEP = ":" if $^O =~ /Mac/;
$DIRSEP = "/" if $^O =~ /unix|linux/i;
$DIRSEP = "\\" if $^O =~ /win/i;
my $pwd = `pwd`; chop $pwd; $pwd .= $DIRSEP unless $pwd =~ /$DIRSEP$/;
my $module = shift;
$module =~ s/::/$DIRSEP/g;
$module .= ".pm";
if( -r $pwd.$module ) { return $pwd.$module }
my $libdir;
foreach $libdir ( @INC ) {
=for debug
print "searching for '$module' in '$libdir' ...\n";
=cut
$libdir .= $DIRSEP unless $libdir =~ /$DIRSEP$/;
if( -r $libdir.$module ) { return $libdir.$module }
}
warn "NOT FOUND: '$module' neither in '$pwd' or @INC paths";
}
sub print_INC {
my $key; # don't assume newer Perl
foreach $key ( sort keys %INC ) { print "$key => $INC{ $key }\n" };
print scalar keys %INC, " key(s) found.\n";
}
# BEGIN {
die "no input, no output\nplease supply argument (MacPerlers drop a file)" unless
$ARGV[0];
my $sourcefile = $ARGV[0];
open S, $sourcefile or die "cannot open '$sourcefile'";
my $pwd = `pwd`; chop $pwd;
my $sourcedir;
if( $^O =~ /mac/i ) { ( $sourcedir ) = ( $sourcefile =~ m/(.*:).+$/ ) }
elsif( $^O =~ /unix|linux/i ) { ( $sourcedir ) = ( $sourcefile =~ m/(.*\/).+$/ ) }
elsif( $^O =~ /win/i ) { ( $sourcedir ) = ( $sourcefile =~ m/(.*\\).+$/ ) }
else { die "unknown OS" }
$sourcedir ||= $pwd;
chdir( $sourcedir ) or die $!;
eval_use_line( $sourcefile );
eval_require_line( $sourcefile );
print_INC();
close S;
foreach my $incs ( values %INC ) {
recurse_required( $incs );
}
print "=" x 40, "\n";
print_INC();
# }
__END__
=head1 NAME
module-finder
=head1 SYNOPSIS
Mac:
drop a file onto the droplet
rest:
perl module-finder.pl <your-perl-script>
=head1 OPTIONS
none in the moment
=head1 DESCRIPTION
The script tries to find all modules a script would need at runtime and fills
%INC accordingly.
The driving idea is to use those values in compiler like programs,
more specifically in the RuntimeBuilder utility for MacPerl.
First the source script itself is scanned. Lines containing a "use" statement
are evaluated. Lines containing a "require" statement are changed so that
they become a "use" statement and then evaluated. The global hash %INC will
be filled that way.
Second the %INC hash will be scanned. For each entry, i.e. each module,
we search for further "require" statements. If such a statement will be
found "require" is replaced by "use" and another evaluation proceeds.
If now %INC is still growing the newly added module in %INC must be checked
for further "require" statements. This goes on recursively until %INC stops
increasing, thereby ensuring that %INC contains all modules ever needed
at runtime of the source script.
=head1 AUTHOR
Axel Rose, [EMAIL PROTECTED]
idea and first revision October 2001
=head1 BUGS
My POD skip code relies on the hope that each pod section ends with "\n=cut".
I'm not sure whether this is true.
please report found bugs to [EMAIL PROTECTED]
=head1 EXAMPLE
analyzing the simple script:
use Socket;
module-finder reports:
Carp.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Carp.pm
Exporter.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Exporter.pm
Socket.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Socket.pm
XSLoader.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:XSLoader.pm
strict.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:strict.pm
warnings.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:warnings.pm
warnings/register.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:warnings:register.pm
7 key(s) found.
INFO: new dependencies found in 'Festplatte:Projekte:MacPerl5.6.1b1:lib:Exporter.pm'
- 'Exporter::Heavy'
INFO: new dependencies found in 'Festplatte:Projekte:MacPerl5.6.1b1:lib:Carp.pm' -
'Carp::Heavy'
INFO: new dependencies found in 'Festplatte:Projekte:MacPerl5.6.1b1:lib:XSLoader.pm'
- 'DynaLoader'
========================================
AutoLoader.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:AutoLoader.pm
Carp.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Carp.pm
Carp/Heavy.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Carp:Heavy.pm
Config.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Config.pm
DynaLoader.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:DynaLoader.pm
Exporter.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Exporter.pm
Exporter/Heavy.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Exporter:Heavy.pm
Socket.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:Socket.pm
XSLoader.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:XSLoader.pm
strict.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:strict.pm
vars.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:vars.pm
warnings.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:warnings.pm
warnings/register.pm => Festplatte:Projekte:MacPerl5.6.1b1:lib:warnings:register.pm
13 key(s) found.
Explanation:
"Exporter" requires "Exporter::Heavy" which then requires "Carp" which requires
"Carp::Heavy"
"Exporter/Heavy.pm" is added to %INC by executing 'eval( "use Exporter::Heavy" )'
"Exporter/Heavy.pm" does "require Carp" a few times which has no effect because
"Carp.pm" is already in %INC
when checking "Carp.pm" one would find "require Carp::Heavy"
"XSLoader" requires "DynaLoader" which requires other already included modules plus
"AutoLoader"
but "AutoLoader" doesn't add new modules either
=head1 SEE ALSO
=head1 COPYRIGHT
This program is free software. You may copy or
redistribute it under the same terms as Perl itself.
=head1 VERSION
in development
=cut
--
----------------------------------------------------------------------
Axel Rose, Springer & Jacoby Digital GmbH & Co. KG, mailto:[EMAIL PROTECTED]
pub PGP key 1024/A21CB825 E0E4 BC69 E001 96E9 2EFD 86CA 9CA1 AAC5
"... denn alles, was entsteht, ist wert, da� es zugrunde geht ..."
