=item OBJECT_REMOTE_LOG_FORWARDING
-Forward log events from remote connections to the local Perl interpreter. Set to 1 to enable
-this feature which is disabled by default. See L<Object::Remote::Logging>.
+Forward log events from remote connections to the local Perl interpreter. Set to 0 to disable
+this feature which is enabled by default. See L<Object::Remote::Logging>.
=item OBJECT_REMOTE_LOG_SELECTIONS
has send_to_fh => (
is => 'ro', required => 1,
trigger => sub {
- my $self = $_[0];
- $_[1]->autoflush(1);
- Dlog_trace { my $id = $self->_id; "connection had send_to_fh set to $_" } $_[1];
+ my $self = $_[0];
+ $_[1]->autoflush(1);
+ Dlog_trace { my $id = $self->_id; "connection had send_to_fh set to $_" } $_[1];
},
);
has on_close => (
is => 'rw', default => sub { $_[0]->_install_future_handlers(CPS::Future->new) },
trigger => sub {
- log_trace { "Installing handlers into future via trigger" };
- $_[0]->_install_future_handlers($_[1])
+ log_trace { "Installing handlers into future via trigger" };
+ $_[0]->_install_future_handlers($_[1])
},
);
my $pid = $self->child_pid;
unless (defined $pid) {
- log_trace { "After BUILD invoked for connection but there was no pid" };
- return;
+ log_trace { "After BUILD invoked for connection but there was no pid" };
+ return;
}
log_trace { "Setting process group of child process '$pid'" };
use Scalar::Util qw(weaken blessed);
use Object::Remote::Logging qw ( :log :dlog router );
use Object::Remote::Future;
-#must find way to exclude certain log events
-#from being forwarded - log events generated in
-#response to log events cause exploding
-#use Object::Remote::Logging qw(:log);
use Module::Runtime qw(use_module);
use Moo;
}
sub _parse_selections {
- my ($selections_string) = @_;
- my %log_ok;
+ my ($selections_string) = @_;
+ my %log_ok;
- #example string:
- #" * -Object::Remote::Logging Foo::Bar::Baz "
- foreach(split(/\s+/, $selections_string)) {
- next if $_ eq '';
- if ($_ eq '*') {
- $log_ok{$_} = 1;
- } elsif (s/^-//) {
- $log_ok{$_} = 0;
- } else {
- $log_ok{$_} = 1;
- }
+ #example string:
+ #" * -Object::Remote::Logging Foo::Bar::Baz "
+ foreach(split(/\s+/, $selections_string)) {
+ next if $_ eq '';
+ if ($_ eq '*') {
+ $log_ok{$_} = 1;
+ } elsif (s/^-//) {
+ $log_ok{$_} = 0;
+ } else {
+ $log_ok{$_} = 1;
}
+ }
- return %log_ok;
+ return %log_ok;
}
#this is invoked on all nodes
package Object::Remote::Logging::LogAnyInjector;
+#Experimental object that can be used to receive Log::Any
+#generated log messages and inject them into the log router
+
use Moo;
use Object::Remote::Logging qw( router );
use Carp qw(croak);
}
sub _build_max_level {
- my ($self) = @_;
- return $self->level_names->[-1];
+ my ($self) = @_;
+ return $self->level_names->[-1];
}
sub _build__level_active {
my $write_count = 0;
my @c = caller;
my $wait_time = $self->_next_timer_expires_delay;
- log_trace { sprintf("Run loop: loop_once() has been invoked by $c[1]:$c[2] with read:%i write:%i select timeout:%s",
- scalar(keys(%$read)), scalar(keys(%$write)), defined $wait_time ? $wait_time : 'indefinite' ) };
+ log_trace {
+ sprintf("Run loop: loop_once() has been invoked by $c[1]:$c[2] with read:%i write:%i select timeout:%s",
+ scalar(keys(%$read)), scalar(keys(%$write)), defined $wait_time ? $wait_time : 'indefinite' )
+ };
my ($readable, $writeable) = IO::Select->select(
$self->_read_select, $self->_write_select, undef, $wait_time
);
}
sub _build_perl_command {
- my ($self) = @_;
- my $nice = $self->nice;
- my $ulimit = $self->ulimit;
- my $perl_path = 'perl';
- my $shell_code = '';
-
- if (defined($ulimit)) {
- $shell_code .= "ulimit $ulimit || exit 1; ";
- }
+ my ($self) = @_;
+ my $nice = $self->nice;
+ my $ulimit = $self->ulimit;
+ my $perl_path = 'perl';
+ my $shell_code = '';
- if (defined($nice)) {
- $shell_code .= "nice -n $nice ";
- }
+ if (defined($ulimit)) {
+ $shell_code .= "ulimit $ulimit || exit 1; ";
+ }
- if (defined($ENV{OBJECT_REMOTE_PERL_BIN})) {
- log_debug { "Using OBJECT_REMOTE_PERL_BIN environment variable as perl path" };
- $perl_path = $ENV{OBJECT_REMOTE_PERL_BIN};
- }
+ if (defined($nice)) {
+ $shell_code .= "nice -n $nice ";
+ }
+
+ if (defined($ENV{OBJECT_REMOTE_PERL_BIN})) {
+ log_debug { "Using OBJECT_REMOTE_PERL_BIN environment variable as perl path" };
+ $perl_path = $ENV{OBJECT_REMOTE_PERL_BIN};
+ }
- $shell_code .= $perl_path . ' -';
+ $shell_code .= $perl_path . ' -';
- return [ 'bash', '-c', $shell_code ];
+ return [ 'bash', '-c', $shell_code ];
}
around connect => sub {