reject XSLoader at fatnode module loader if it made it through

[scpubgit/Object-Remote.git] / lib / Object / Remote / FatNode.pm

diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm
index d76a21d..f95705d 100644 (file)
--- a/lib/Object/Remote/FatNode.pm
+++ b/lib/Object/Remote/FatNode.pm
@@ -40,17 +40,18 @@ chomp(my @inc = qx($command));
 
 my %mods = reverse @inc;
 
-my @non_core_non_arch = grep +(
-  not (
-    /^\Q$Config{privlibexp}/ or /^\Q$Config{archlibexp}/
-    or /^\Q$Config{vendorarchexp}/ or /^\Q$Config{sitearchexp}/
-  )
-), keys %mods;
-
-my @core_non_arch = grep +(
-  /^\Q$Config{privlibexp}/
-  and not(/^\Q$Config{archlibexp}/ or /\Q$Config{archname}/ or /\Q$Config{myarchname}/)
-), keys %mods;
+#my @non_core = grep +(
+#  not (
+#    /^\Q$Config{privlibexp}/ or /^\Q$Config{archlibexp}/
+#  )
+#), keys %mods;
+
+my @non_core = keys %mods; 
+
+#my @core_non_arch = grep +(
+#  /^\Q$Config{privlibexp}/
+#), grep !/\Q$Config{archname}/, grep !/\Q$Config{myarchname}/, keys %mods;
+my @core_non_arch; 
 
 my $start = stripspace <<'END_START';
   # This chunk of stuff was generated by Object::Remote::FatNode. To find
@@ -63,10 +64,16 @@ my $end = stripspace <<'END_END';
   s/^  //mg for values %fatpacked, values %fatpacked_extra;
 
   sub load_from_hash {
+    if ($_[1] eq 'XSLoader.pm') {
+      warn "XSLoader made it into the fat node";
+      return undef; 
+    }
+
     if (my $fat = $_[0]->{$_[1]}) {
       open my $fh, '<', \$fat;
       return $fh;
     }
+    
     #Uncomment this to find brokenness
     #warn "Missing $_[1]";
     return
@@ -83,7 +90,7 @@ my $end = stripspace <<'END_END';
 END_END
 
 my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }),
-              @non_core_non_arch, @core_non_arch;
+              @non_core, @core_non_arch;
 
 sub generate_fatpack_hash {
   my ($hash_name, $orig) = @_;
@@ -94,9 +101,14 @@ sub generate_fatpack_hash {
   .qq!${data}${name}\n!;
 }
 
+use Data::Dumper;
+warn "Dumping list of shipped modules";
+print STDERR "Core non-arch: ", Dumper(\@core_non_arch);
+print STDERR "Non-core: ", Dumper(\@non_core); 
+
 my @segments = (
-    map(generate_fatpack_hash('fatpacked', $_), sort map $mods{$_}, @non_core_non_arch),
-    map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @core_non_arch),
+  map(generate_fatpack_hash('fatpacked', $_), sort map $mods{$_}, @non_core),
+  map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @core_non_arch),
 );
 
 our $DATA = join "\n", $start, @segments, $end;