BuildAll and DemolishAll are loaded on first ->new so need to be explicitly packed
[scpubgit/Object-Remote.git] / lib / Object / Remote / FatNode.pm
CommitLineData
eee9a548 1package Object::Remote::FatNode;
2
3use strictures 1;
4use Config;
5use B qw(perlstring);
6
7sub stripspace {
8 my ($text) = @_;
9 $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
10 $text;
11}
12
13my %maybe_libs = map +($_ => 1), grep defined, (values %Config, '.');
14
15my @extra_libs = grep not(ref($_) or $maybe_libs{$_}), @INC;
16
17my $extra_libs = join '', map " -I$_\n", @extra_libs;
18
19my $command = qq(
20 $^X
21 $extra_libs
22 -mObject::Remote
23 -mObject::Remote::Connector::STDIO
24 -mCPS::Future
25 -mClass::C3
26 -mObject::Remote::ModuleLoader
27 -mObject::Remote::Node
4c8c83d7 28 -mMethod::Generate::BuildAll
29 -mMethod::Generate::DemolishAll
eee9a548 30 -mJSON::PP
31 -e 'print join "\\n", reverse \%INC'
32);
33
34$command =~ s/\n/ /g;
35
36chomp(my %mods = qx($command));
37
38my @non_core_non_arch = grep +(
39 not (/^\Q$Config{privlibexp}/ or /^\Q$Config{archlibexp}/)
40), grep !/\Q$Config{archname}/, grep !/\W$Config{myarchname}/, keys %mods;
41
42my $start = stripspace <<'END_START';
43 # This chunk of stuff was generated by Object::Remote::FatNode. To find
44 # the original file's code, look for the end of this BEGIN block or the
45 # string 'FATPACK'
46 BEGIN {
47 my %fatpacked;
48END_START
49my $end = stripspace <<'END_END';
50 s/^ //mg for values %fatpacked;
51
52 unshift @INC, sub {
53 if (my $fat = $fatpacked{$_[1]}) {
54 open my $fh, '<', \$fat;
55 return $fh;
56 }
57 return
58 };
59
60 } # END OF FATPACK CODE
61
62 use strictures 1;
63 use Object::Remote::Node;
64 Object::Remote::Node->run;
65END_END
66
67my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }),
68 @non_core_non_arch;
69
70my @segments = map {
71 (my $stub = $_) =~ s/\.pm$//;
72 my $name = uc join '_', split '/', $stub;
73 my $data = $files{$_}; $data =~ s/^/ /mg;
74 '$fatpacked{'.perlstring($_).qq!} = <<'${name}';\n!
75 .qq!${data}${name}\n!;
76} sort keys %files;
77
78our $DATA = join "\n", $start, @segments, $end;
79
801;