package Object::Remote::FatNode;
-#TODO If a file does not end in a new line by itself
-#then fat node fails
-
use strictures 1;
use Config;
use B qw(perlstring);
+#used by t/watchdog_fatnode
+our $INHIBIT_RUN_NODE = 0;
+
sub stripspace {
my ($text) = @_;
$text =~ /^(\s+)/ && $text =~ s/^$1//mg;
my %mods = reverse @inc;
-#TODO oi this isn't right yet
-my @non_core_non_arch = grep +(
+my @non_core = grep +(
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;
+), grep !/\Q$Config{archname}/, grep !/\Q$Config{myarchname}/, keys %mods;
my $env_pass = '';
if (defined($ENV{OBJECT_REMOTE_LOG_LEVEL})) {
- my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL};
- return unless $level =~ /^\w+$/;
- $env_pass = '$ENV{OBJECT_REMOTE_LOG_LEVEL} = "' . $level . "\";\n";
+ my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL};
+ return unless $level =~ /^\w+$/;
+ $env_pass = '$ENV{OBJECT_REMOTE_LOG_LEVEL} = "' . $level . "\";\n";
}
my $start = stripspace <<'END_START';
use strictures 1;
use Object::Remote::Node;
- Object::Remote::Node->run(watchdog_timeout => $WATCHDOG_TIMEOUT);
+
+ unless ($Object::Remote::FatNode::INHIBIT_RUN_NODE) {
+ Object::Remote::Node->run(watchdog_timeout => $WATCHDOG_TIMEOUT);
+ }
+
END_END
my %files = map +($mods{$_} => scalar do { local (@ARGV, $/) = ($_); <> }),
- @non_core_non_arch, @core_non_arch;
+ @non_core, @core_non_arch;
sub generate_fatpack_hash {
my ($hash_name, $orig) = @_;
}
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),
+ map(generate_fatpack_hash('fatpacked', $_), sort map $mods{$_}, @non_core),
+ map(generate_fatpack_hash('fatpacked_extra', $_), sort map $mods{$_}, @core_non_arch),
);
our $DATA = join "\n", $start, $env_pass, @segments, $end;