Skip Menu |
 

This queue is for tickets about the Log-Dispatch CPAN distribution.

Report information
The Basics
Id: 48283
Status: resolved
Priority: 0/
Queue: Log-Dispatch

People
Owner: Nobody in particular
Requestors: rjbs [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: (no value)
Fixed in: 2.23



Subject: add an add_callback method so we can add callbacks later [PATCH/DOCS/TEST]
I worked around this in my code already, but it'd be a little convenience. -- rjbs
Subject: 0001-add_callback.patch
From 503a65390c324e44ac1900711d72b83e5346fd42 Mon Sep 17 00:00:00 2001 From: Ricardo SIGNES <rjbs@cpan.org> Date: Tue, 28 Jul 2009 23:04:39 -0400 Subject: [PATCH] add_callback --- lib/Log/Dispatch.pm | 18 ++++++++++++++++++ t/01-basic.t | 40 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 57 insertions(+), 1 deletions(-) diff --git a/lib/Log/Dispatch.pm b/lib/Log/Dispatch.pm index 9dfb269..e9e4ecd 100644 --- a/lib/Log/Dispatch.pm +++ b/lib/Log/Dispatch.pm @@ -63,6 +63,19 @@ sub remove return delete $self->{outputs}{$name}; } +sub add_callback +{ + my $self = shift; + my $value = shift; + + Carp::carp("given value $value is not a valid callback") + unless UNIVERSAL::isa( $value, 'CODE' ); + + $self->{callbacks} ||= []; + push @{ $self->{callbacks} }, $value; + return; +} + sub log { my $self = shift; @@ -320,6 +333,11 @@ anything would be logged for that log level. Returns an output of the given name. Returns undef or an empty list, depending on context, if the given output does not exist. +=item * add_callback( $code ) + +Adds a callback (like those given during initialization). It is added to the +end of the list of callbacks, if others are already set. + =back =head1 CONVENIENCE METHODS diff --git a/t/01-basic.t b/t/01-basic.t index 42d1733..2dc6a2d 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 146; +use Test::More tests => 150; use File::Spec; use File::Temp qw( tempdir ); @@ -637,6 +637,44 @@ SKIP: is( $string, 'croak', 'message is logged' ); } +{ + my $string; + + my $dispatch = Log::Dispatch->new; + $dispatch->add( Log::Dispatch::String->new( name => 'handle', + string => \$string, + min_level => 'debug', + ) ); + + $dispatch->log(level => 'debug', message => 'foo'); + is($string, 'foo', 'first test w/o callback'); + + $string = ''; + $dispatch->add_callback(sub { return 'bar' }); + $dispatch->log(level => 'debug', message => 'foo'); + is($string, 'bar', 'second call, callback overrides message'); +} + +{ + my $string; + + my $dispatch = Log::Dispatch->new( + callbacks => sub { return 'baz' }, + ); + $dispatch->add( Log::Dispatch::String->new( name => 'handle', + string => \$string, + min_level => 'debug', + ) ); + + $dispatch->log(level => 'debug', message => 'foo'); + is($string, 'baz', 'first test gets orig callback result'); + + $string = ''; + $dispatch->add_callback(sub { return 'bar' }); + $dispatch->log(level => 'debug', message => 'foo'); + is($string, 'bar', 'second call, callback overrides message'); +} + SKIP: { skip 'Cannot do syslog tests without Sys::Syslog 0.16+', 2 -- 1.6.3.1


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.