X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FFatNode.pm;h=819d657b1e80d75cc5d35c3fb34174d0ff4ba051;hp=0d4ee055978e392e2035928934a039a05c4a6e9d;hb=de9062cfef7f98d0efc01b114328959f2f84ada4;hpb=15b847bbaf9afc1e8370481a29be9164399fde51 diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm index 0d4ee05..819d657 100644 --- a/lib/Object/Remote/FatNode.pm +++ b/lib/Object/Remote/FatNode.pm @@ -44,18 +44,19 @@ chomp(my @inc = qx($command)); my %exclude = map { $_ => 1 } @exclude_mods; my %mods = reverse @inc; +my %file_names = @inc; foreach(keys(%mods)) { if ($exclude{ $mods{$_} }) { - delete($mods{$_}); + delete($mods{$_}); } } -my @non_core_non_arch = ( $mods{'Devel/GlobalDestruction.pm'} ); +my @non_core_non_arch = ( $file_names{'Devel/GlobalDestruction.pm'} ); push @non_core_non_arch, grep +( not ( #some of the config variables can be empty which will eval as a matching regex - $Config{privlibexp} ne '' && /^\Q$Config{privlibexp}/ + $Config{privlibexp} ne '' && /^\Q$Config{privlibexp}/ or $Config{archlibexp} ne '' && /^\Q$Config{archlibexp}/ or $Config{vendorarchexp} ne '' && /^\Q$Config{vendorarchexp}/ or $Config{sitearchexp} ne '' && /^\Q$Config{sitearchexp}/ @@ -68,36 +69,6 @@ my @core_non_arch = grep +( or /\Q$Config{archname}/ or /\Q$Config{myarchname}/) ), keys %mods; -#print STDERR "non-core non-arch ", Dumper(\@non_core_non_arch); -#print STDERR "core non-arch ", Dumper(\@core_non_arch); - -#TODO this is the wrong path to go down - fork() will bring -#the env vars with it and the ssh connector can handle -#forwarding the env vars -my $env_pass = ''; -if (defined($ENV{OBJECT_REMOTE_LOG_LEVEL})) { - my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL}; - $env_pass .= '$ENV{OBJECT_REMOTE_LOG_LEVEL} = "' . $level . "\";\n"; -} -if (defined($ENV{OBJECT_REMOTE_LOG_FORMAT})) { - my $format = $ENV{OBJECT_REMOTE_LOG_FORMAT}; - $env_pass .= '$ENV{OBJECT_REMOTE_LOG_FORMAT} = "' . $format . "\";\n"; -} -if (defined($ENV{OBJECT_REMOTE_LOG_SELECTIONS})) { - my $selections = $ENV{OBJECT_REMOTE_LOG_SELECTIONS}; - $env_pass .= '$ENV{OBJECT_REMOTE_LOG_SELECTIONS} = "' . $selections . "\";\n"; -} -if (defined($ENV{OBJECT_REMOTE_LOG_FORWARDING})) { - my $forwarding = $ENV{OBJECT_REMOTE_LOG_FORWARDING}; - $env_pass .= '$ENV{OBJECT_REMOTE_LOG_FORWARDING} = "' . $forwarding . "\";\n"; -} -if (defined($ENV{OBJECT_REMOTE_PERL_BIN})) { - my $perl_bin = $ENV{OBJECT_REMOTE_PERL_BIN}; - $env_pass .= '$ENV{OBJECT_REMOTE_PERL_BIN} = "' . $perl_bin . "\";\n"; -} - - - my $start = stripspace <<'END_START'; # This chunk of stuff was generated by Object::Remote::FatNode. To find # the original file's code, look for the end of this BEGIN block or the @@ -115,14 +86,14 @@ my $end = stripspace <<'END_END'; if (my $fat = $_[0]->{$_[1]}) { if ($exclude{$_[1]}) { warn "Will not pre-load '$_[1]'"; - return undef; + return undef; } - + #warn "Handling $_[1]"; open my $fh, '<', \$fat; return $fh; } - + #Uncomment this to find brokenness #warn "Missing $_[1]"; return; @@ -135,11 +106,11 @@ my $end = stripspace <<'END_END'; use strictures 1; use Object::Remote::Node; - + unless ($Object::Remote::FatNode::INHIBIT_RUN_NODE) { - Object::Remote::Node->run(watchdog_timeout => $WATCHDOG_TIMEOUT); + Object::Remote::Node->run(watchdog_timeout => $WATCHDOG_TIMEOUT); } - + END_END my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }), @@ -162,6 +133,7 @@ my @segments = ( map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @core_non_arch), ); -our $DATA = join "\n", $start, $env_pass, @segments, $end; +#print STDERR Dumper(\@segments); +our $DATA = join "\n", $start, @segments, $end; 1;