From: Dagfinn Ilmari Mannsåker Date: Fri, 27 Jul 2012 13:26:54 +0000 (+0100) Subject: Fall back to core non-arch modules in FatNode X-Git-Tag: v0.003001_01~135 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1ef3d225bfb434c7ae608946827419478c40a59e;p=scpubgit%2FObject-Remote.git Fall back to core non-arch modules in FatNode --- diff --git a/Changes b/Changes index ca670e8..ef33fe2 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,5 @@ - Propagate errors from FatNode code + - Fall back to core non-arch modules in FatNode 0.002003 - 2012-07-25 - Exclude vendorarch and sitearch from FatNode and ModuleSender diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm index 773b552..845c12b 100644 --- a/lib/Object/Remote/FatNode.pm +++ b/lib/Object/Remote/FatNode.pm @@ -47,25 +47,33 @@ my @non_core_non_arch = grep +( ) ), grep !/\Q$Config{archname}/, grep !/\Q$Config{myarchname}/, 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 $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 # string 'FATPACK' BEGIN { - my %fatpacked; + my (%fatpacked,%fatpacked_extra); END_START my $end = stripspace <<'END_END'; - s/^ //mg for values %fatpacked; + s/^ //mg for values %fatpacked, values %fatpacked_extra; - unshift @INC, sub { - if (my $fat = $fatpacked{$_[1]}) { + sub load_from_hash { + if (my $fat = $_[0]->{$_[1]}) { open my $fh, '<', \$fat; return $fh; } #Uncomment this to find brokenness #warn "Missing $_[1]"; return - }; + } + + unshift @INC, sub { load_from_hash(\%fatpacked, $_[1]) }; + push @INC, sub { load_from_hash(\%fatpacked_extra, $_[1]) }; } # END OF FATPACK CODE @@ -75,15 +83,21 @@ my $end = stripspace <<'END_END'; END_END my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }), - @non_core_non_arch; + @non_core_non_arch, @core_non_arch; -my @segments = map { - (my $stub = $_) =~ s/\.pm$//; +sub generate_fatpack_hash { + my ($hash_name, $orig) = @_; + (my $stub = $orig) =~ s/\.pm$//; my $name = uc join '_', split '/', $stub; - my $data = $files{$_}; $data =~ s/^/ /mg; - '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n! + my $data = $files{$orig} or die $orig; $data =~ s/^/ /mg; + return '$'.$hash_name.'{'.perlstring($orig).qq!} = <<'${name}';\n! .qq!${data}${name}\n!; -} sort keys %files; +} + +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), +); our $DATA = join "\n", $start, @segments, $end;