extends 'Log::Contextual';
sub router {
- our $Router_Instance ||= do {
- require Object::Remote::Logging::Router;
- Object::Remote::Logging::Router->new;
- }
+ our $Router_Instance ||= do {
+ require Object::Remote::Logging::Router;
+ Object::Remote::Logging::Router->new;
+ }
}
sub arg_levels {
- return [qw( trace debug verbose info warn error )];
+ return [qw( trace debug verbose info warn error )];
}
#this is invoked on all nodes
sub init_logging {
- my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL};
- return unless defined $level;
- my $logger = Object::Remote::Logging::Logger->new(
- min_level => lc($level),
- level_names => Object::Remote::Logging::arg_levels(),
- );
-
- #TODO check on speed of string compare against a hash with a single key
- router()->connect(sub {
- return unless $_[1]->{controller} eq __PACKAGE__;
- #skip things from remote hosts because they log to STDERR
- #when OBJECT_REMOTE_LOG_LEVEL is in effect
- return if $_[1]->{remote}->{connection_id};
- $logger
- });
+ my $level = $ENV{OBJECT_REMOTE_LOG_LEVEL};
+ return unless defined $level;
+ my $logger = Object::Remote::Logging::Logger->new(
+ min_level => lc($level),
+ level_names => Object::Remote::Logging::arg_levels(),
+ );
+
+ #TODO check on speed of string compare against a hash with a single key
+ router()->connect(sub {
+ return unless $_[1]->{controller} eq __PACKAGE__;
+ #skip things from remote hosts because they log to STDERR
+ #when OBJECT_REMOTE_LOG_LEVEL is in effect
+ return if $_[1]->{remote}->{connection_id};
+ $logger
+ });
}
#this is invoked by the controlling node
has _level_active => ( is => 'lazy' );
sub BUILD {
- my ($self) = @_;
- our $METHODS_INSTALLED;
- $self->_install_methods unless $METHODS_INSTALLED;
+ my ($self) = @_;
+ our $METHODS_INSTALLED;
+ $self->_install_methods unless $METHODS_INSTALLED;
}
sub _build__level_active {
- my ($self) = @_;
- my $should_log = 0;
- my $min_level = $self->min_level;
- my $max_level = $self->max_level;
- my %active;
+ my ($self) = @_;
+ my $should_log = 0;
+ my $min_level = $self->min_level;
+ my $max_level = $self->max_level;
+ my %active;
- foreach my $level (@{$self->level_names}) {
- if($level eq $min_level) {
- $should_log = 1;
- }
-
- $active{$level} = $should_log;
+ foreach my $level (@{$self->level_names}) {
+ if($level eq $min_level) {
+ $should_log = 1;
+ }
+
+ $active{$level} = $should_log;
- if (defined $max_level && $level eq $max_level) {
- $should_log = 0;
- }
+ if (defined $max_level && $level eq $max_level) {
+ $should_log = 0;
}
-
- return \%active;
+ }
+
+ return \%active;
}
sub _install_methods {
- my ($self) = @_;
- my $should_log = 0;
- our $METHODS_INSTALLED = 1;
+ my ($self) = @_;
+ my $should_log = 0;
+ our $METHODS_INSTALLED = 1;
- no strict 'refs';
+ no strict 'refs';
- foreach my $level (@{$self->level_names}) {
- *{"is_$level"} = sub { shift(@_)->_level_active->{$level} };
- *{$level} = sub { shift(@_)->_log($level, @_) };
- }
+ foreach my $level (@{$self->level_names}) {
+ *{"is_$level"} = sub { shift(@_)->_level_active->{$level} };
+ *{$level} = sub { shift(@_)->_log($level, @_) };
+ }
}
sub _log {
- my ($self, $level, $content, $metadata_in) = @_;
- #TODO this stinks but is backwards compatible with the original logger api
- my %metadata = %$metadata_in;
- my $rendered = $self->_render($level, \%metadata, @$content);
- $self->_output($rendered);
+ my ($self, $level, $content, $metadata_in) = @_;
+ #TODO this stinks but is backwards compatible with the original logger api
+ my %metadata = %$metadata_in;
+ my $rendered = $self->_render($level, \%metadata, @$content);
+ $self->_output($rendered);
}
sub _render {
- my ($self, $level, $metadata, @content) = @_;
- my $rendered = "[$level] ";
- my $remote_info = $metadata->{object_remote};
-
- if ($remote_info) {
- $rendered .= "[connection #$remote_info->{connection_id}] ";
- } else {
- $rendered .= "[local] ";
- }
+ my ($self, $level, $metadata, @content) = @_;
+ my $rendered = "[$level] ";
+ my $remote_info = $metadata->{object_remote};
+
+ if ($remote_info) {
+ $rendered .= "[connection #$remote_info->{connection_id}] ";
+ } else {
+ $rendered .= "[local] ";
+ }
- $rendered .= join('', @content);
- $rendered .= "\n" unless substr($rendered, -1) eq "\n";
- return $rendered;
+ $rendered .= join('', @content);
+ $rendered .= "\n" unless substr($rendered, -1) eq "\n";
+ return $rendered;
}
sub _output {
- my ($self, $content) = @_;
- print STDERR $content;
+ my ($self, $content) = @_;
+ print STDERR $content;
}
has _remote_metadata => ( is => 'rw' );
sub before_import {
- my ($self, $controller, $importer, $spec) = @_;
+ my ($self, $controller, $importer, $spec) = @_;
}
sub after_import { }
sub _get_loggers {
- my ($self, %metadata) = @_;
- my $package = $metadata{package};
- my $level = $metadata{level};
- my $is_level = "is_$level";
- my $need_clean = 0;
- my @loggers;
-
- foreach my $selector (@{$self->_connections}) {
- unless(defined $selector) {
- $need_clean = 1;
- next;
- }
-
- foreach my $logger ($selector->($package, { %metadata })) {
- next unless defined $logger;
- my $method = $logger->can($is_level);
- next unless defined $method;
- next unless $logger->$method;
- push(@loggers, $logger);
- }
+ my ($self, %metadata) = @_;
+ my $package = $metadata{package};
+ my $level = $metadata{level};
+ my $is_level = "is_$level";
+ my $need_clean = 0;
+ my @loggers;
+
+ foreach my $selector (@{$self->_connections}) {
+ unless(defined $selector) {
+ $need_clean = 1;
+ next;
+ }
+
+ foreach my $logger ($selector->($package, { %metadata })) {
+ next unless defined $logger;
+ my $method = $logger->can($is_level);
+ next unless defined $method;
+ next unless $logger->$method;
+ push(@loggers, $logger);
}
+ }
- $self->_clean_connections if $need_clean;
-
- return @loggers;
+ $self->_clean_connections if $need_clean;
+
+ return @loggers;
}
sub handle_log_request {
- my ($self, $metadata_in, $generator, @args) = @_;
- my %metadata = %{$metadata_in};
- my $level = $metadata{level};
- my $package = $metadata{package};
- my $need_clean = 0;
-
- #caller_level is useless when log forwarding is in place
- #so we won't tempt people with using it for now - access
- #to caller level will be available in the future
- delete $metadata{caller_level};
- $metadata{object_remote} = $self->_remote_metadata;
-
- foreach my $logger ($self->_get_loggers(%metadata)) {
- $logger->$level([ $generator->(@args) ], \%metadata);
- }
+ my ($self, $metadata_in, $generator, @args) = @_;
+ my %metadata = %{$metadata_in};
+ my $level = $metadata{level};
+ my $package = $metadata{package};
+ my $need_clean = 0;
+
+ #caller_level is useless when log forwarding is in place
+ #so we won't tempt people with using it for now - access
+ #to caller level will be available in the future
+ delete $metadata{caller_level};
+ $metadata{object_remote} = $self->_remote_metadata;
+
+ foreach my $logger ($self->_get_loggers(%metadata)) {
+ $logger->$level([ $generator->(@args) ], \%metadata);
+ }
}
sub connect {
- my ($self, $destination) = @_;
- my $wrapped;
-
- if (ref($destination) ne 'CODE') {
- $wrapped = sub { $destination };
- } else {
- $wrapped = $destination;
- }
-
- push(@{$self->_connections}, $wrapped);
+ my ($self, $destination) = @_;
+ my $wrapped;
+
+ if (ref($destination) ne 'CODE') {
+ $wrapped = sub { $destination };
+ } else {
+ $wrapped = $destination;
+ }
+
+ push(@{$self->_connections}, $wrapped);
}
sub _clean_connections {
- my ($self) = @_;
- @{$self->{_connections}} = grep { defined } @{$self->{_connections}};
+ my ($self) = @_;
+ @{$self->{_connections}} = grep { defined } @{$self->{_connections}};
}
1;
};
sub exclude_forwarding {
- my ($self, $package) = @_;
- $package = caller unless defined $package;
- $self->_forward_stop->{$package} = 1;
+ my ($self, $package) = @_;
+ $package = caller unless defined $package;
+ $self->_forward_stop->{$package} = 1;
}
1;