update Makefile.PL with better metadata
[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
f6ac5927 7my @exclude_mods = qw(XSLoader.pm DynaLoader.pm);
1bf55307 8#used by t/watchdog_fatnode
f1d70835 9our $INHIBIT_RUN_NODE = 0;
f6ac5927 10
eee9a548 11sub stripspace {
12 my ($text) = @_;
13 $text =~ /^(\s+)/ && $text =~ s/^$1//mg;
14 $text;
15}
16
17my %maybe_libs = map +($_ => 1), grep defined, (values %Config, '.');
18
668343cd 19my @extra_libs = grep not(ref($_) or $maybe_libs{$_}), @INC;
20my $extra_libs = join '', map {
21 my $lib = $_;
22 $lib =~ s{'}{'\\''}g;
23 " -I'$lib'\n";
24} @extra_libs;
eee9a548 25
26my $command = qq(
27 $^X
28 $extra_libs
29 -mObject::Remote
30 -mObject::Remote::Connector::STDIO
783105c4 31 -mFuture
8c81a0e5 32 -mMRO::Compat
eee9a548 33 -mClass::C3
8c81a0e5 34 -mClass::C3::next
35 -mAlgorithm::C3
eee9a548 36 -mObject::Remote::ModuleLoader
37 -mObject::Remote::Node
4c8c83d7 38 -mMethod::Generate::BuildAll
39 -mMethod::Generate::DemolishAll
dd6e1327 40 -mMoo::HandleMoose::_TypeMap
eee9a548 41 -mJSON::PP
6845582f 42 -mDevel::GlobalDestruction
df8e0ca6 43 -e 'print join "\\n", \%INC'
eee9a548 44);
45
46$command =~ s/\n/ /g;
47
df8e0ca6 48chomp(my @inc = qx($command));
49
1bf55307 50my %exclude = map { $_ => 1 } @exclude_mods;
e454581e 51
5e850e3e 52my %file_names = @inc;
eee9a548 53
e454581e 54# only include mods that match the filename,
55# ie ones that will succeed with a require $module
56# https://rt.cpan.org/Ticket/Display.html?id=100478
57my %mods =
58 map { $file_names{$_} => $_ }
59 grep { $file_names{$_} =~ /\Q$_\E$/ } keys %file_names;
60
f6ac5927 61foreach(keys(%mods)) {
62 if ($exclude{ $mods{$_} }) {
55c0d020 63 delete($mods{$_});
f6ac5927 64 }
65}
66
5e850e3e 67my @non_core_non_arch = ( $file_names{'Devel/GlobalDestruction.pm'} );
15b847bb 68push @non_core_non_arch, grep +(
61c6bba7 69 not (
15b847bb 70 #some of the config variables can be empty which will eval as a matching regex
55c0d020 71 $Config{privlibexp} ne '' && /^\Q$Config{privlibexp}/
15b847bb 72 or $Config{archlibexp} ne '' && /^\Q$Config{archlibexp}/
73 or $Config{vendorarchexp} ne '' && /^\Q$Config{vendorarchexp}/
74 or $Config{sitearchexp} ne '' && /^\Q$Config{sitearchexp}/
75 )
76), grep !/\Q$Config{archname}/, grep !/\Q$Config{myarchname}/, keys %mods;
77
78my @core_non_arch = grep +(
79 $Config{privlibexp} ne '' && /^\Q$Config{privlibexp}/
80 and not($Config{archlibexp} ne '' && /^\Q$Config{archlibexp}/
81 or /\Q$Config{archname}/ or /\Q$Config{myarchname}/)
82), keys %mods;
83
eee9a548 84my $start = stripspace <<'END_START';
85 # This chunk of stuff was generated by Object::Remote::FatNode. To find
86 # the original file's code, look for the end of this BEGIN block or the
87 # string 'FATPACK'
88 BEGIN {
1ef3d225 89 my (%fatpacked,%fatpacked_extra);
eee9a548 90END_START
f6ac5927 91
cc62b744 92$start .= 'my %exclude = map { $_ => 1 } (\'' . join("','", @exclude_mods) . "');\n";
f6ac5927 93
eee9a548 94my $end = stripspace <<'END_END';
1ef3d225 95 s/^ //mg for values %fatpacked, values %fatpacked_extra;
eee9a548 96
1ef3d225 97 sub load_from_hash {
98 if (my $fat = $_[0]->{$_[1]}) {
f6ac5927 99 if ($exclude{$_[1]}) {
100 warn "Will not pre-load '$_[1]'";
55c0d020 101 return undef;
f6ac5927 102 }
55c0d020 103
cc62b744 104 #warn "Handling $_[1]";
eee9a548 105 open my $fh, '<', \$fat;
106 return $fh;
107 }
55c0d020 108
8c81a0e5 109 #Uncomment this to find brokenness
110 #warn "Missing $_[1]";
f6ac5927 111 return;
1ef3d225 112 }
113
114 unshift @INC, sub { load_from_hash(\%fatpacked, $_[1]) };
115 push @INC, sub { load_from_hash(\%fatpacked_extra, $_[1]) };
eee9a548 116
117 } # END OF FATPACK CODE
118
119 use strictures 1;
120 use Object::Remote::Node;
55c0d020 121
f129bfaf 122 unless ($Object::Remote::FatNode::INHIBIT_RUN_NODE) {
55c0d020 123 Object::Remote::Node->run(watchdog_timeout => $WATCHDOG_TIMEOUT);
f129bfaf 124 }
55c0d020 125
eee9a548 126END_END
127
128my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }),
15b847bb 129 @non_core_non_arch, @core_non_arch;
eee9a548 130
1ef3d225 131sub generate_fatpack_hash {
132 my ($hash_name, $orig) = @_;
133 (my $stub = $orig) =~ s/\.pm$//;
eee9a548 134 my $name = uc join '_', split '/', $stub;
1ef3d225 135 my $data = $files{$orig} or die $orig; $data =~ s/^/ /mg;
3ab6f7e2 136 $data .= "\n" unless $data =~ m/\n$/;
137 my $ret = '$'.$hash_name.'{'.perlstring($orig).qq!} = <<'${name}';\n!
138 .qq!${data}${name}\n!;
139# warn $ret;
140 return $ret;
1ef3d225 141}
142
143my @segments = (
15b847bb 144 map(generate_fatpack_hash('fatpacked', $_), sort map $mods{$_}, @non_core_non_arch),
145 map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @core_non_arch),
1ef3d225 146);
eee9a548 147
90f5193d 148#print STDERR Dumper(\@segments);
149our $DATA = join "\n", $start, @segments, $end;
eee9a548 150
1511;