X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FObject%2FRemote%2FFatNode.pm;h=d76a21d344181feb6b2cd9a9df7128e594daed82;hb=f225a19938aca6ee9f1effd7d0eb64e90657e30f;hp=9f94ee289cf45e9f516ed96e2bdcd8f2dd511a7a;hpb=4c8c83d78afaf57a918d50198866b6d2a08acb75;p=scpubgit%2FObject-Remote.git diff --git a/lib/Object/Remote/FatNode.pm b/lib/Object/Remote/FatNode.pm index 9f94ee2..d76a21d 100644 --- a/lib/Object/Remote/FatNode.pm +++ b/lib/Object/Remote/FatNode.pm @@ -22,40 +22,58 @@ my $command = qq( -mObject::Remote -mObject::Remote::Connector::STDIO -mCPS::Future + -mMRO::Compat -mClass::C3 + -mClass::C3::next + -mAlgorithm::C3 -mObject::Remote::ModuleLoader -mObject::Remote::Node -mMethod::Generate::BuildAll -mMethod::Generate::DemolishAll -mJSON::PP - -e 'print join "\\n", reverse \%INC' + -e 'print join "\\n", \%INC' ); $command =~ s/\n/ /g; -chomp(my %mods = qx($command)); +chomp(my @inc = qx($command)); + +my %mods = reverse @inc; my @non_core_non_arch = grep +( - not (/^\Q$Config{privlibexp}/ or /^\Q$Config{archlibexp}/) -), grep !/\Q$Config{archname}/, grep !/\W$Config{myarchname}/, keys %mods; + 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 $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 @@ -65,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;