Ok, well I've got the automatic runtime detection and addition of modules patches to
pp and Module::ScanDeps going, and there are plusses and minuses for using
either.
Basically, you add '-c' to the command line if you want to compile a script to detect
dependencies, and you add '-e' if you want to run a script (with arguments) to detect
dependencies. For example
pp -c -e 'use Data::Dumper; print STDERR Dumper(\%INC);';
will put a sub block around your statement and evaluate the 'use Data::Dumper' without
executing the script, and
pp -c script_name.p
will do the same for script_name.
pp -x 'script_name.p arguments' will run script_name.p with 'arguments' as arguments,
and
pp -x -e 'use Data::Dumper; print STDERR Dumper(\%INC);';
will run the one liner with no arguments
As it stands, this '-x' and 'c' is done as a supplement to what Module::ScanDeps
currently
does, but you can use '-n' to make this the *only* way that you package modules.
This has advantages in space - but also may miss a couple of things.
The benefits I see (of -c or -x in combo with the -n flag) are:
1) handles runtime eval better (ie: eval, require "$stuff", etc).
This helps a lot for things like Inline, autoload, etc.
2) produces a smaller binary
However, there are a couple of cases where perl is still frustratingly elusive to pin
down.
For one, if you use code refs in @INC, things go south real fast. You cannot - as far
as I can see - reconstruct the modules that a given perl script loads from a coderef,
and things like Inline are still troublesome because they only include their sub
modules
if they are needed (ex: Inline::C is only loaded on use to compile c-code)
And finally, the patch requires a small patch to perl itself (it uses dynaloader to get
a list of loadable modules)
Anyways, below is all three patches. I'd be very interested in hearing feedback on them
and if it is going to be incorporated into the next version of PAR... I've submitted
the dynaloader patch to perl5-porters.
Ed
---- patches below. apply with patch -p1 -d :module_code_root: < patch ----
diff -rc perl-5.8.1/ext/DynaLoader/DynaLoader_pm.PL
perl-5.8.1.new/ext/DynaLoader/DynaLoader_pm.PL
*** perl-5.8.1/ext/DynaLoader/DynaLoader_pm.PL Sat Sep 13 10:14:41 2003
--- perl-5.8.1.new/ext/DynaLoader/DynaLoader_pm.PL Tue Nov 18 23:39:39 2003
***************
*** 80,85 ****
--- 80,86 ----
my $Mac_FS;
$Mac_FS = eval { require Mac::FileSpec::Unixish } if $Is_MacOS;
+ @dl_shared_objects = (); # shared objects for symbols we have
@dl_require_symbols = (); # names of symbols we need
@dl_resolve_using = (); # names of files to link with
@dl_library_path = (); # path to look for files
***************
*** 328,335 ****
boot:
my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
-
# See comment block above
&$xs(@args);
}
--- 329,338 ----
boot:
my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
# See comment block above
+
+ push(@dl_shared_objects, $file); # record files loaded
+
&$xs(@args);
}
***************
*** 548,553 ****
--- 551,557 ----
$dl_debug
@dl_librefs
@dl_modules
+ @dl_shared_objects
Implemented in:
bootstrap($modulename) Perl
@filepaths = dl_findfile(@names) Perl
***************
*** 622,627 ****
--- 626,635 ----
=item @dl_modules
An array of module (package) names that have been bootstrap'ed.
+
+ =item @dl_shared_objects
+
+ An array of file names for the shared objects that were loaded.
=item dl_error()
diff -rc PAR-0.76/script/pp PAR.test/script/pp
*** PAR-0.76/script/pp Tue Nov 18 11:31:27 2003
--- PAR.test/script/pp Tue Nov 18 11:34:06 2003
***************
*** 95,118 ****
unshift @INC, @{opt(I) || []};
unshift @SharedLibs, map _find_shlib($_), @{opt(l) || []};
! Module::ScanDeps::scan_deps(
! rv => \%map,
! files => [
! (map Module::ScanDeps::_find_in_inc($_), @modules),
! (@Input ? @Input : ()),
! ],
! recurse => 1,
! skip => {
! map { (Module::ScanDeps::_find_in_inc($_) => 1) } @exclude
! }
! );
! Module::ScanDeps::add_deps(
! rv => \%map,
! modules => [EMAIL PROTECTED],
! skip => {
! map { (Module::ScanDeps::_find_in_inc($_) => 1) } @exclude
! }
! );
my %text;
$text{$_} = ($map{$_}{type} =~ /^(?:module|autoload)$/) for keys %map;
--- 96,148 ----
unshift @INC, @{opt(I) || []};
unshift @SharedLibs, map _find_shlib($_), @{opt(l) || []};
! $DB::single = 1;
! if (!opt(n))
! {
! Module::ScanDeps::scan_deps
! (
! rv => \%map,
! files => [
! (map Module::ScanDeps::_find_in_inc($_), @modules),
! (@Input ? @Input : ()),
! ],
! recurse => 1,
! first => 1,
!
! execute => opt(x),
! compile => opt(c),
!
! skip => {
! map { (Module::ScanDeps::_find_in_inc($_) => 1) } @exclude
! }
! );
!
! Module::ScanDeps::add_deps
! (
! rv => \%map,
! modules => [EMAIL PROTECTED],
! skip => {
! map { (Module::ScanDeps::_find_in_inc($_) => 1) } @exclude
! }
! );
! }
! else
! {
! Module::ScanDeps::scan_deps_runtime
! (
! rv => \%map,
! files =>
! [
! (map Module::ScanDeps::_find_in_inc($_), @modules),
! (@Input ? @Input : ()),
! ],
! execute => opt(x),
! compile => opt(c),
!
! skip => { map { (Module::ScanDeps::_find_in_inc($_) => 1) }
@exclude }
! );
! }
!
my %text;
$text{$_} = ($map{$_}{type} =~ /^(?:module|autoload)$/) for keys %map;
***************
*** 443,448 ****
--- 473,481 ----
'B|bundle', # Bundle core modules
'd|dependent', # Do not package libperl
'e|eval:s', # Packing one-liner
+ 'x|execute:s', # execute string first to get list of modules to pack
+ 'c|compile', # compile script/module to get list of modules to pack
+ 'n|nodep', # only use runtime analysis to find libraries
'X|exclude:s@', # Exclude modules
'f|filter:s@', # Input filters for scripts
'g|gui', # No console window
diff -rc Module-ScanDeps-0.32/lib/Module/ScanDeps/DataFeed.pm
Module-ScanDeps-0.32-test/lib/Module/ScanDeps/DataFeed.pm
*** Module-ScanDeps-0.32/lib/Module/ScanDeps/DataFeed.pm Tue Nov 18 11:37:14
2003
--- Module-ScanDeps-0.32-test/lib/Module/ScanDeps/DataFeed.pm Mon Nov 17 17:53:54
2003
***************
*** 0 ****
--- 1,39 ----
+ package Module::ScanDeps::DataFeed;
+ use DynaLoader;
+ use strict;
+ use Cwd qw (abs_path);
+
+ my $_filename;
+
+ sub import
+ {
+ my ($pkg, $filename) = @_;
+
+ $_filename = $filename;
+ }
+
+ END
+ {
+ open(FD, "> $_filename") || die "Couldn't open $_filename\n"; #"
+
+ print FD '%inchash = (' . "\n\t";
+ print FD join(',', map("\n\t'$_' => '" . Cwd::abs_path($INC{$_}) . "'",
keys(%INC)));
+ print FD "\n);\n";
+
+
+ print FD '@incarray = (' . "\n\t";
+ print FD join(',', map("\n\t'$_'", @INC));
+ print FD "\n);\n";
+
+ my @dl_bs = @DynaLoader::dl_shared_objects;
+ grep(s"(\.so|\.dll)$"\.bs", @dl_bs); #"
+ @dl_bs = grep(-e $_, @dl_bs);
+
+
+ print FD '@dl_shared_objects = (' . "\n\t";
+ print FD join(',', map("\n\t'$_'", @DynaLoader::dl_shared_objects, @dl_bs));
+ print FD "\n);\n";
+
+ close(FD);
+ }
+ 1;
diff -rc Module-ScanDeps-0.32/lib/Module/ScanDeps.pm
Module-ScanDeps-0.32-test/lib/Module/ScanDeps.pm
*** Module-ScanDeps-0.32/lib/Module/ScanDeps.pm Sun Oct 26 02:51:26 2003
--- Module-ScanDeps-0.32-test/lib/Module/ScanDeps.pm Mon Nov 17 22:51:47 2003
***************
*** 1,19 ****
! # $File: //member/autrijus/Module-ScanDeps/lib/Module/ScanDeps.pm $ $Author:
autrijus $
! # $Revision: #6 $ $Change: 8568 $ $DateTime: 2003/10/26 10:50:46 $
package Module::ScanDeps;
use vars qw/$VERSION @EXPORT @EXPORT_OK/;
$VERSION = '0.32';
! @EXPORT = qw(scan_deps);
! @EXPORT_OK = qw(scan_line scan_chunk add_deps);
use strict;
use Exporter;
use base 'Exporter';
use Config;
use constant dl_ext => ".$Config{dlext}";
use constant lib_ext => $Config{lib_ext};
=head1 NAME
--- 1,23 ----
! # $File: //member/autrijus/Module-ScanDeps/lib/Module/ScanDeps.pm $ $Author: tools $
! # $Revision: 1.1.2.5 $ $Change: 8568 $ $DateTime: 2003/10/26 10:50:46 $
package Module::ScanDeps;
use vars qw/$VERSION @EXPORT @EXPORT_OK/;
$VERSION = '0.32';
! @EXPORT = qw(scan_deps scan_deps_runtime);
! @EXPORT_OK = qw(scan_line scan_chunk add_deps scan_deps_runtime);
use strict;
+ use Data::Dumper;
use Exporter;
use base 'Exporter';
use Config;
+ use File::Temp qw(mktemp);
+ use FileHandle;
use constant dl_ext => ".$Config{dlext}";
use constant lib_ext => $Config{lib_ext};
+ use Cwd qw(abs_path);
=head1 NAME
***************
*** 252,263 ****
);
# }}}
! sub scan_deps {
my %args = (
! (@_ and $_[0] =~ /^(?:files|keys|recurse|rv|skip)$/)
? @_ : ( files => [ @_ ], recurse => 1 )
);
! my ($files, $keys, $recurse, $rv, $skip) = @args{qw/files keys recurse rv skip/};
$rv ||= {}; $skip ||= {};
--- 256,290 ----
);
# }}}
! sub scan_deps
! {
my %args = (
! (@_ and $_[0] =~ /^(?:files|keys|recurse|rv|skip|first|execute|compile)$/)
? @_ : ( files => [ @_ ], recurse => 1 )
);
!
! _scan_deps(\%args);
! if ( defined($args{execute}) || $args{compile} )
! {
! scan_deps_runtime
! (
! rv => $args{rv},
! files => $args{files},
! execute => $args{execute},
! compile => $args{compile},
! skip => $args{skip}
! );
! }
!
! return($args{rv});
! }
!
! sub _scan_deps
! {
! my ($args) = @_;
!
! my ($files, $keys, $recurse, $rv, $skip, $first, $execute, $compile) =
! @$args{qw/files keys recurse rv skip first execute compile/};
$rv ||= {}; $skip ||= {};
***************
*** 303,315 ****
while ($recurse) {
my $count = keys %$rv;
my @files = sort grep -T $_->{file}, values %$rv;
! scan_deps(
! files => [ map $_->{file}, @files ],
! keys => [ map $_->{key}, @files ],
! rv => $rv,
! skip => $skip,
! recurse => 0,
! ) or ($args{_deep} and return);
last if $count == keys %$rv;
}
# }}}
--- 330,344 ----
while ($recurse) {
my $count = keys %$rv;
my @files = sort grep -T $_->{file}, values %$rv;
! _scan_deps(
! {
! files => [ map $_->{file}, @files ],
! keys => [ map $_->{key}, @files ],
! rv => $rv,
! skip => $skip,
! recurse => 0,
! }
! ) or ($args->{_deep} and return);
last if $count == keys %$rv;
}
# }}}
***************
*** 317,323 ****
return $rv;
}
! sub scan_line {
my $line = shift;
my %found;
--- 346,586 ----
return $rv;
}
! sub scan_deps_runtime
! {
! my %args = (
! (@_ and $_[0] =~ /^(?:files|keys|recurse|rv|skip|first|execute|compile)$/)
! ? @_ : ( files => [ @_ ], recurse => 1 )
! );
! my ($files, $rv, $execute, $compile, $skip, $perl) =
! @args{qw/files rv execute compile skip perl/};
!
! $perl ||= $^X;
! $files = (ref($files))? $files : [ $files ];
!
! $rv ||= {};
! my ($inchash, $incarray, $dl_shared_objects) = ( {}, [], []);
! if ($compile)
! {
! my $file;
!
! foreach $file (@$files)
! {
! ($inchash, $dl_shared_objects, $incarray) = ( {}, [], []);
! _compile($perl, $file, $inchash, $dl_shared_objects,
$incarray);
!
! my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
! _merge_rv($rv_sub, $rv);
! }
! }
! elsif (defined($execute))
! {
! my $excarray = (ref($execute))? $execute :
! (defined($execute) && !$execute)? [ @$files ] : [
$execute ];
!
! my $exc;
! my $first_flag = 1;
! foreach $exc (@$excarray)
! {
! ( $inchash, $dl_shared_objects, $incarray ) = ( {}, [], []);
! _execute($perl, $exc, $inchash, $dl_shared_objects, $incarray,
$first_flag);
! $first_flag = 0;
! }
! my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
! _merge_rv($rv_sub, $rv);
! }
!
! return($rv);
! }
!
! sub _compile
! {
! my ($perl, $file, $inchash, $dl_shared_objects, $incarray) = @_;
!
! my ($fname) = mktemp("$file.XXXXXX");
!
! my ($fhin) = new FileHandle($file) || die "Couldn't open $file\n";
! my $fhout = new FileHandle("> $fname") || die "Couldn't open $fname\n";
! local($/) = undef;
!
! my $line = <$fhin>;
! $line =~ s"use Module::ScanDeps::DataFeed.*?\n""sg;
! $line =~ s"^(.*?)((?:[\r\n]+__[A-Z]__[\r\n]+)|$)"
! use Module::ScanDeps::DataFeed qw($fname.out);
! sub
! {
! $1
! }
! $2"sx; #"
!
! print $fhout "$line";
! close($fhout);
!
! system("$perl $fname");
!
! _extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
! unlink("$fname");
! unlink("$fname.out");
! }
!
! sub _execute
! {
! my ($perl, $file, $inchash, $dl_shared_objects, $incarray, $firstflag) = @_;
!
! $DB::single = 1;
! my $fname if (0);
! $fname = mktemp("$file.XXXXXX");
! $fname = Cwd::abs_path($fname);
!
! my ($fhin) = new FileHandle($file) || die "Couldn't open $file\n";
! my $fhout = new FileHandle("> $fname") || die "Couldn't open $fname\n";
! local($/) = undef;
!
! my $line = <$fhin>;
! $line =~ s"use Module::ScanDeps::DataFeed.*?\n""sg;
!
! $line = <<"EOF";
! use Module::ScanDeps::DataFeed qw($fname.out);
! $line
! EOF
!
! print $fhout "$line";
! close($fhout);
!
! system("rm -rf _Inline"); # needs to be done for inline... HACK!!!
! system("$perl $fname");
! die "SYSTEM ERROR in executing $file: $@" if ($@);
!
! _extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
! unlink("$fname");
! unlink("$fname.out");
! }
!
! sub _make_rv
! {
! my ($inchash, $dl_shared_objects, $inc_array) = @_;
!
! my $rv = {};
!
! my @newinc = map(quotemeta($_), @$inc_array);
!
! my $inc = join('|', sort { length($b) <=> length($a) } @newinc);
!
! my $key;
! foreach $key (keys(%$inchash))
! {
! my $newkey = $key;
! $newkey =~ s"^(?:(?:$inc)/?)""sg if ($newkey =~ m"^/");
!
! $rv->{$newkey} =
! {
! 'used_by' => [],
! 'file' => $inchash->{$key},
! 'type' =>
_gettype($inchash->{$key}),
! 'key' => $key
! };
! }
!
! my $dl_file;
! foreach $dl_file (@$dl_shared_objects)
! {
! my $key = $dl_file;
! $key =~ s"^(?:(?:$inc)/?)""s;
!
! $rv->{$key} =
! {
! 'used_by' => [],
! 'file' => $dl_file,
! 'type' => 'shared',
! 'key' => $key
! };
! }
!
! return($rv);
! }
!
! sub _extract_info
! {
! my ($fname, $inchash, $dl_shared_objects, $incarray) = @_;
!
! use vars qw (%inchash @dl_shared_objects @incarray);
! my $fh = new FileHandle($fname) || die "SYSTEM ERROR: Couldn't open $fname";
!
! local($/) = undef;
! my $line = <$fh>;
! close($fh);
!
! eval("$line");
! my $key;
!
! foreach $key (keys(%inchash)) { $inchash->{$key} = $inchash{$key}; }
! @$dl_shared_objects = @dl_shared_objects;
! @$incarray = @incarray;
! }
!
! sub _gettype
! {
! my ($name) = @_;
!
! my $dlext = dl_ext();
! ($name =~ m"(?:\.ix|\.al|\.bs)$")? 'autoload': #"
! ($name =~ m"(?:\.pl|\.p)$")? 'data' : #"
! ($name =~ m"(?:\.pm)$")? 'module' : #"
! ($name =~ m"(?:\.$dlext)$")? 'shared' : #"
! 'data';
! }
!
! sub _merge_rv
! {
! my ($rv_sub, $rv) [EMAIL PROTECTED];
!
! my $key;
! foreach $key (keys(%$rv_sub))
! {
! my %mark;
! if ($rv->{$key} && _not_dup($key, $rv, $rv_sub))
! {
!
! print STDERR "SYSTEM WARNING: Two different modules for file
:$key: were found (using the version) after the '=>': $rv->{$key}{file} =>
$rv_sub->{$key}{file}\n";
!
! $rv->{$key}{used_by} =
! [ grep ( !$mark{$_}++, @{$rv->{$key}{used_by}},
@{$rv_sub->{$key}{used_by}}) ];
! @{$rv->{$key}{used_by}} = grep(length($_) > 0,
@{$rv->{$key}{used_by}});
!
! $rv->{$key}{file} = $rv_sub->{$key}{file};
!
! }
! elsif ($rv->{$key})
! {
! $rv->{$key}{used_by} =
! [ grep ( !$mark{$_}++, @{$rv->{$key}{used_by}},
@{$rv_sub->{$key}{used_by}}) ];
! @{$rv->{$key}{used_by}} = grep(length($_) > 0,
@{$rv->{$key}{used_by}});
! }
! else
! {
! $rv->{$key} =
! {
! used_by => [ @{$rv_sub->{$key}{used_by}} ],
! file => $rv_sub->{$key}{file},
! key => $rv_sub->{$key}{'key'},
! type => $rv_sub->{$key}{'type'}
! };
!
! @{$rv->{$key}{used_by}} = grep(length($_),
@{$rv->{$key}{used_by}});
! }
! }
! }
!
! sub _not_dup
! {
! my ($key, $rv1, $rv2) = @_;
!
! return(1) if (abs_path($rv1->{$key}{'file'}) ne
abs_path($rv2->{$key}{'file'}));
! return(0);
! }
!
! sub scan_line
! {
my $line = shift;
my %found;
