1package Log::Dispatch::Base; 2{ 3 $Log::Dispatch::Base::VERSION = '2.34'; 4} 5 6use strict; 7use warnings; 8 9sub _get_callbacks { 10 shift; 11 my %p = @_; 12 13 return unless exists $p{callbacks}; 14 15 return @{ $p{callbacks} } 16 if UNIVERSAL::isa( $p{callbacks}, 'ARRAY' ); 17 18 return $p{callbacks} 19 if UNIVERSAL::isa( $p{callbacks}, 'CODE' ); 20 21 return; 22} 23 24sub _apply_callbacks { 25 my $self = shift; 26 my %p = @_; 27 28 my $msg = delete $p{message}; 29 foreach my $cb ( @{ $self->{callbacks} } ) { 30 $msg = $cb->( message => $msg, %p ); 31 } 32 33 return $msg; 34} 35 36sub add_callback { 37 my $self = shift; 38 my $value = shift; 39 40 Carp::carp("given value $value is not a valid callback") 41 unless ref $value eq 'CODE'; 42 43 $self->{callbacks} ||= []; 44 push @{ $self->{callbacks} }, $value; 45 46 return; 47} 48 491; 50 51# ABSTRACT: Code shared by dispatch and output objects. 52 53__END__ 54 55=pod 56 57=head1 NAME 58 59Log::Dispatch::Base - Code shared by dispatch and output objects. 60 61=head1 VERSION 62 63version 2.34 64 65=head1 SYNOPSIS 66 67 use Log::Dispatch::Base; 68 69 ... 70 71 @ISA = qw(Log::Dispatch::Base); 72 73=head1 DESCRIPTION 74 75Unless you are me, you probably don't need to know what this class 76does. 77 78=head1 AUTHOR 79 80Dave Rolsky <autarch@urth.org> 81 82=head1 COPYRIGHT AND LICENSE 83 84This software is Copyright (c) 2011 by Dave Rolsky. 85 86This is free software, licensed under: 87 88 The Artistic License 2.0 (GPL Compatible) 89 90=cut 91