add option to reset @INC to defaults at top of fatpacked script topic/core-only
David Golden [Wed, 9 Jul 2014 22:56:43 +0000 (18:56 -0400)]
lib/App/FatPacker.pm
t/pack.t

index c127ca7..20a0053 100644 (file)
@@ -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
index c88b9e1..2af80d0 100644 (file)
--- 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;