X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FObject-Remote.git;a=blobdiff_plain;f=lib%2FObject%2FRemote%2FLogRouter.pm;h=17108dcd1e81009b2f610654a6f271dbb78274ab;hp=9fa20e0938c8ff8193e953299e049d70b1c70dd1;hb=5d59cb9859e004df5cde5d83aa7230e621a28b95;hpb=a63cd862186adf328e26dd1294e7a3b1adc42ed6 diff --git a/lib/Object/Remote/LogRouter.pm b/lib/Object/Remote/LogRouter.pm index 9fa20e0..17108dc 100644 --- a/lib/Object/Remote/LogRouter.pm +++ b/lib/Object/Remote/LogRouter.pm @@ -10,8 +10,8 @@ has description => ( is => 'rw', required => 1 ); sub before_import { } sub after_import { - my ($self, $controller, $importer, $config) = @_; - my $logger = $controller->arg_logger($config->{logger}); + my ($self, $controller, $importer, $config) = @_; + my $logger = $controller->arg_logger($config->{logger}); # TODO need to review this concept, ignore these configuration values for now # my $package_logger = $controller->arg_package_logger($config->{package_logger}); @@ -37,70 +37,70 @@ sub after_import { } sub subscribe { - my ($self, $logger, $selector, $is_temp) = @_; - my $subscription_list = $self->subscriptions; + my ($self, $logger, $selector, $is_temp) = @_; + my $subscription_list = $self->subscriptions; - if(ref $logger ne 'CODE') { - die 'logger was not a CodeRef or a logger object. Please try again.' - unless blessed($logger); - $logger = do { my $l = $logger; sub { $l } } - } + if(ref $logger ne 'CODE') { + die 'logger was not a CodeRef or a logger object. Please try again.' + unless blessed($logger); + $logger = do { my $l = $logger; sub { $l } } + } my $subscription = [ $logger, $selector ]; $is_temp = 0 unless defined $is_temp; push(@$subscription_list, $subscription); if ($is_temp) { - #weaken($subscription->[-1]); + #weaken($subscription->[-1]); } return $subscription; } #TODO turn this logic into a role sub handle_log_message { - my ($self, $caller, $level, $log_meth, @values) = @_; - my $should_clean = 0; + my ($self, $caller, $level, $log_meth, @values) = @_; + my $should_clean = 0; - foreach(@{ $self->subscriptions }) { - unless(defined($_)) { - $should_clean = 1; - next; - } - my ($logger, $selector) = @$_; - #TODO this is not a firm part of the api but providing - #this info to the selector is a good feature - local($_) = { level => $level, package => $caller }; - if ($selector->(@values)) { - #TODO resolve caller_level issues with routing - #idea: the caller level will differ in distance from the - #start of the call stack but it's a constant distance from - #the end of the call stack - can that be exploited to calculate - #the distance from the start right before it's used? - # - #newer idea: in order for log4perl to work right the logger - #must be invoked in the exported log_* method directly - #so by passing the logger down the chain of routers - #it can be invoked in that location and the caller level - #problem doesn't exist anymore - $logger = $logger->($caller, { caller_level => -1 }); + foreach(@{ $self->subscriptions }) { + unless(defined($_)) { + $should_clean = 1; + next; + } + my ($logger, $selector) = @$_; + #TODO this is not a firm part of the api but providing + #this info to the selector is a good feature + local($_) = { level => $level, package => $caller }; + if ($selector->(@values)) { + #TODO resolve caller_level issues with routing + #idea: the caller level will differ in distance from the + #start of the call stack but it's a constant distance from + #the end of the call stack - can that be exploited to calculate + #the distance from the start right before it's used? + # + #newer idea: in order for log4perl to work right the logger + #must be invoked in the exported log_* method directly + #so by passing the logger down the chain of routers + #it can be invoked in that location and the caller level + #problem doesn't exist anymore + $logger = $logger->($caller, { caller_level => -1 }); - $logger->$level($log_meth->(@values)) - if $logger->${\"is_$level"}; - } + $logger->$level($log_meth->(@values)) + if $logger->${\"is_$level"}; + } } if ($should_clean) { - $self->_remove_dead_subscriptions; + $self->_remove_dead_subscriptions; } return; } sub _remove_dead_subscriptions { - my ($self) = @_; - my @ok = grep { defined $_ } @{$self->subscriptions}; - @{$self->subscriptions} = @ok; - return; + my ($self) = @_; + my @ok = grep { defined $_ } @{$self->subscriptions}; + @{$self->subscriptions} = @ok; + return; }