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=0d4ee055978e392e2035928934a039a05c4a6e9d;hp=819b9a5d2660448d767665e8b31d60e543b3820b;hb=572a9a00cec239943f92157ec39c44398aad137f;hpb=837cfa50bac9501ba39c18f06bbe0a76bc0b9dfd diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm index 819b9a5..0d4ee05 100644 --- a/lib/Object/Remote/FatNode.pm +++ b/lib/Object/Remote/FatNode.pm @@ -6,7 +6,7 @@ use B qw(perlstring); my @exclude_mods = qw(XSLoader.pm DynaLoader.pm); #used by t/watchdog_fatnode -our $INHIBIT_RUN_NODE = 0; +our $INHIBIT_RUN_NODE = 0; sub stripspace { my ($text) = @_; @@ -51,15 +51,25 @@ foreach(keys(%mods)) { } } -sub filter_not_core { +my @non_core_non_arch = ( $mods{'Devel/GlobalDestruction.pm'} ); +push @non_core_non_arch, grep +( not ( - /^\Q$Config{privlibexp}/ or /^\Q$Config{archlibexp}/ - ) -} - -my @file_names = keys %mods; -my @before_inc = grep { filter_not_core() } @file_names; -my @after_inc; + #some of the config variables can be empty which will eval as a matching regex + $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}/ + ) +), grep !/\Q$Config{archname}/, grep !/\Q$Config{myarchname}/, keys %mods; + +my @core_non_arch = grep +( + $Config{privlibexp} ne '' && /^\Q$Config{privlibexp}/ + and not($Config{archlibexp} ne '' && /^\Q$Config{archlibexp}/ + 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 @@ -81,6 +91,10 @@ 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"; +} @@ -129,20 +143,23 @@ my $end = stripspace <<'END_END'; END_END my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }), - @before_inc, @after_inc; + @non_core_non_arch, @core_non_arch; sub generate_fatpack_hash { my ($hash_name, $orig) = @_; (my $stub = $orig) =~ s/\.pm$//; my $name = uc join '_', split '/', $stub; my $data = $files{$orig} or die $orig; $data =~ s/^/ /mg; - return '$'.$hash_name.'{'.perlstring($orig).qq!} = <<'${name}';\n! - .qq!${data}${name}\n!; + $data .= "\n" unless $data =~ m/\n$/; + my $ret = '$'.$hash_name.'{'.perlstring($orig).qq!} = <<'${name}';\n! + .qq!${data}${name}\n!; +# warn $ret; + return $ret; } my @segments = ( - map(generate_fatpack_hash('fatpacked', $_), sort map $mods{$_}, @before_inc), - map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @after_inc), + map(generate_fatpack_hash('fatpacked', $_), sort map $mods{$_}, @non_core_non_arch), + map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @core_non_arch), ); our $DATA = join "\n", $start, $env_pass, @segments, $end;