From: David Golden Date: Wed, 9 Jul 2014 22:56:43 +0000 (-0400) Subject: add option to reset @INC to defaults at top of fatpacked script X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a03c42fa97a506acb0c677cbc5fdf88f57a9443d;p=p5sagit%2FApp-FatPacker.git add option to reset @INC to defaults at top of fatpacked script --- diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm index c127ca7..20a0053 100644 --- a/lib/App/FatPacker.pm +++ b/lib/App/FatPacker.pm @@ -70,6 +70,10 @@ sub script_command_help { sub script_command_pack { my ($self, $args) = @_; + $args = $self->call_parser($args => [ + 'core-only' => \my $core_only, + ]); + my @modules = split /\r?\n/, $self->trace(args => $args); my @packlists = $self->packlists_containing(\@modules); @@ -77,7 +81,7 @@ sub script_command_pack { $self->packlists_to_tree($base, \@packlists); my $file = shift @$args; - print $self->fatpack_file($file); + print $self->fatpack_file($file, $core_only); } sub script_command_trace { @@ -198,12 +202,17 @@ sub packlists_to_tree { sub script_command_file { my ($self, $args) = @_; + + $args = $self->call_parser($args => [ + 'core-only' => \my $core_only, + ]); + my $file = shift @$args; - print $self->fatpack_file($file); + print $self->fatpack_file($file, $core_only); } sub fatpack_file { - my ($self, $file) = @_; + my ($self, $file, $core_only) = @_; my $shebang = ""; my $script = ""; @@ -215,7 +224,10 @@ sub fatpack_file { my %files; $self->collect_files($_, \%files) for @dirs; - return join "\n", $shebang, $self->fatpack_code(\%files), $script; + my $lib_reset = + "BEGIN { use Config; \@INC = \@Config{qw(privlibexp archlibexp sitelibexp sitearchexp)} }\n"; + + return join "\n", $shebang, ($core_only ? $lib_reset : ()), $self->fatpack_code(\%files), $script; } # This method can be overload in sub classes diff --git a/t/pack.t b/t/pack.t index c88b9e1..2af80d0 100644 --- a/t/pack.t +++ b/t/pack.t @@ -25,7 +25,7 @@ chdir $tempdir; my $fp = App::FatPacker->new; my $temp_fh = File::Temp->new; select $temp_fh; -$fp->script_command_file; +$fp->script_command_file([qw/--core-only/]); print "1;\n"; select STDOUT; close $temp_fh; @@ -33,6 +33,9 @@ close $temp_fh; # make sure we don't pick up things from our created dir chdir File::Spec->tmpdir; +my $guts = do { local (@ARGV,$/) = "$temp_fh"; <> }; +like( $guts, qr/\QBEGIN { use Config\E/, "saw core-only preamble" ); + # Packed, now try using it: require $temp_fh;