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=fe07f29f94d46dacb51bfe2e13075925291a2fa0;hp=b5f3437b0ceb7b15efc25022f1391f114381084d;hb=dd6e1327e96d5488e34f7519d9d3290627c9bbe8;hpb=eb351344773af82344bd550ffd5a8814b816cfeb diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm index b5f3437..fe07f29 100644 --- a/lib/Object/Remote/FatNode.pm +++ b/lib/Object/Remote/FatNode.pm @@ -5,7 +5,7 @@ use Config; use B qw(perlstring); my @exclude_mods = qw(XSLoader.pm DynaLoader.pm); -#used by t/watchdog_fatnode +#used by t/watchdog_fatnode our $INHIBIT_RUN_NODE = 0; sub stripspace { @@ -17,15 +17,18 @@ sub stripspace { my %maybe_libs = map +($_ => 1), grep defined, (values %Config, '.'); my @extra_libs = grep not(ref($_) or $maybe_libs{$_}), @INC; - -my $extra_libs = join '', map " -I$_\n", @extra_libs; +my $extra_libs = join '', map { + my $lib = $_; + $lib =~ s{'}{'\\''}g; + " -I'$lib'\n"; +} @extra_libs; my $command = qq( $^X $extra_libs -mObject::Remote -mObject::Remote::Connector::STDIO - -mCPS::Future + -mFuture -mMRO::Compat -mClass::C3 -mClass::C3::next @@ -34,6 +37,7 @@ my $command = qq( -mObject::Remote::Node -mMethod::Generate::BuildAll -mMethod::Generate::DemolishAll + -mMoo::HandleMoose::_TypeMap -mJSON::PP -e 'print join "\\n", \%INC' ); @@ -42,20 +46,21 @@ $command =~ s/\n/ /g; chomp(my @inc = qx($command)); -my %exclude = map { $_ => 1 } @exclude_mods; +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,32 +73,6 @@ my @core_non_arch = grep +( or /\Q$Config{archname}/ or /\Q$Config{myarchname}/) ), keys %mods; -#FIXME - encode the env vars in YAML or something similiar and make the -#env vars that will be forwarded driven by a list -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 @@ -111,14 +90,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; @@ -131,11 +110,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, $/) = ($_); <> }), @@ -158,6 +137,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;