Hello Axel,
thanks for your work.
on 10/30/01 08:21 AM, Axel Rose at [EMAIL PROTECTED] wrote:
> The task looked not that difficult but as you can see from the code
> below it got larger and larger.
Your code seems to be involved, so I cleaned it up.
Save attached file as Droplet, then try it.
If you don't like my version, please ignore this message.
Best regards,
---
Keitarou Miyazaki
Nagoya, Japan
#!perl -w
use strict;
package ModuleFinder;
my $DIRSEP = $^O =~ /^Mac/
? ':' # mac
: $^O =~ /^win/i
?
'\\' # win
: '/'; # default: unix, linux, *bsd...
=item $obj = CLASS->new($source_file);
=cut
sub new {
my $pkg = shift;
my
$sourcefile = shift or die "No input file.";
my $self = bless {'FILE' =>
$sourcefile, # source file
'INC' => {}, #
required modules
'FILE_VISITED' => {} # processed modules
}, $pkg;
local %INC = (); # preserve original %INC
#
Change directory to souce file's directory.
#
my $pwd = `pwd`; chop $pwd;
my $sep = quotemeta($DIRSEP);
$sourcefile =~ m/^(.*$DIRSEP)[^$DIRSEP]+$/;
my
$sourcedir = $1 || $pwd;
$sourcedir .= $DIRSEP unless $sourcedir =~ /$DIRSEP$/;
chdir( $sourcedir ) or die $!;
# Fetch required modules.
#
$self->_process_file($sourcefile);
foreach my $module (keys %INC) {
if
($module eq $INC{$module}) {
# This module is located in source file's
directory.
# Fix the file name to absolute path name.
$INC{$module} = $sourcedir . $INC{$module};
}
}
%{$self->{'INC'}} =
%INC;
# Back to original directory.
#
chdir($pwd);
$self
}
=item
$obj->show_modules;
=cut
sub show_modules {
my $self = shift;
foreach my
$module (sort keys %{$self->{'INC'}}) {
my $fixed = $module;
$fixed =~
s|/|$DIRSEP|g;
print "'$fixed' => $self->{INC}->{$module}\n";
}
}
=item
%module_list = $obj->modules;
=cut
sub modules {
my $self = shift;
my %ret =
();
foreach my $module (keys %{$self->{'INC'}}) {
my $fixed = $module;
$fixed =~ s|/|$DIRSEP|g;
$ret{$fixed} = $self->{'INC'}->{$module};
}
%ret
}
sub _process_file {
my $self = shift;
my $file = shift;
=for debug
print "FILE: $file\n";
=cut
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;
if (/\brequire\b.+;/) {
$self->_eval_require_line($_);
} elsif (/^\s*use.+;/o) {
$self->_eval_use_line($_);
}
}
close FILE;
$self->{'FILE_VISITED'}->{$file}++;
# process required modules
foreach my
$module (keys %INC) {
$file = $INC{$module};
$self->_process_file($file) unless exists $self->{'FILE_VISITED'}->{$file};
}
}
sub _eval_require_line {
my $self = shift;
local $_ = shift;
if
($self->_not_understandable($_)) {
warn "Skipping: $_";
return;
}
local $^W = 0; # suppress warnings about redefining subroutines
eval $_;
}
sub _eval_use_line {
my $self = shift;
local $_ = shift;
next if
/^\s*use\s+constant/o; # avoid annoying messages on some module...
# fill %INC
local $^W = 0; # suppress warnings about redefining subroutines
eval( $_ );
#
warn "$@ in line '$_'" if $@;
# TODO: what, if "use" statement spans multiple
lines ...
}
sub _not_understandable {
my $self = shift;
local $_ = shift;
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;
}
package main;
my $m = new ModuleFinder $ARGV[0];
$m->show_modules;
# or you can do
# use Data::Dumper;
# my %modules =
ModuleFinder->new($ARGV[0])->modules;
# print Dumper \%modules;
__END__
