File Coverage

blib/lib/Log/Dispatch/Base.pm
Criterion Covered Total %
statement 49 49 100.0
branch 8 10 80.0
condition 4 5 80.0
subroutine 10 10 100.0
pod 0 3 0.0
total 71 77 92.2


line stmt bran cond sub pod time code
1             package Log::Dispatch::Base;
2              
3 29     29   243 use strict;
  29         58  
  29         964  
4 29     29   150 use warnings;
  29         73  
  29         744  
5              
6 29     29   154 use Carp ();
  29         66  
  29         558  
7             use Log::Dispatch::Vars
8 29     29   149 qw( %CanonicalLevelNames %LevelNamesToNumbers @OrderedLevels );
  29         59  
  29         3004  
9 29     29   193 use Scalar::Util qw( refaddr );
  29         49  
  29         14485  
10              
11             our $VERSION = '2.71';
12              
13             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
14             sub _level_as_number {
15 187     187   356 my $self = shift;
16 187         266 my $level = shift;
17              
18 187         899 my $level_name = $self->level_is_valid($level);
19 186 100       456 return unless $level_name;
20              
21 185         762 return $LevelNamesToNumbers{$level_name};
22             }
23             ## use critic
24              
25             sub level_is_valid {
26 202     202 0 9130 shift;
27 202         358 my $level = shift;
28              
29 202 100       494 if ( !defined $level ) {
30 1         242 Carp::croak('Logging level was not provided');
31             }
32              
33 201 100 66     947 if ( $level =~ /\A[0-9]+\z/ && $level <= $#OrderedLevels ) {
34 15         53 return $OrderedLevels[$level];
35             }
36              
37 186         895 return $CanonicalLevelNames{$level};
38             }
39              
40             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
41             sub _apply_callbacks {
42 86     86   225 my $self = shift;
43 86         297 my %p = @_;
44              
45 86         256 my $msg = delete $p{message};
46 86         327 for my $cb ( @{ $self->{callbacks} } ) {
  86         430  
47 89         501 $msg = $cb->( message => $msg, %p );
48             }
49              
50 86         448 return $msg;
51             }
52              
53             sub add_callback {
54 5     5 0 3866 my $self = shift;
55 5         11 my $value = shift;
56              
57 5 50       25 Carp::carp("given value $value is not a valid callback")
58             unless ref $value eq 'CODE';
59              
60 5   100     23 $self->{callbacks} ||= [];
61 5         10 push @{ $self->{callbacks} }, $value;
  5         12  
62              
63 5         14 return;
64             }
65              
66             sub remove_callback {
67 2     2 0 1472 my $self = shift;
68 2         5 my $cb = shift;
69              
70 2 50       9 Carp::carp("given value $cb is not a valid callback")
71             unless ref $cb eq 'CODE';
72              
73 2         11 my $cb_id = refaddr $cb;
74             $self->{callbacks}
75 2         5 = [ grep { refaddr $_ ne $cb_id } @{ $self->{callbacks} } ];
  3         13  
  2         5  
76              
77 2         6 return;
78             }
79              
80             1;
81              
82             # ABSTRACT: Code shared by dispatch and output objects.
83              
84             __END__
85              
86             =pod
87              
88             =encoding UTF-8
89              
90             =head1 NAME
91              
92             Log::Dispatch::Base - Code shared by dispatch and output objects.
93              
94             =head1 VERSION
95              
96             version 2.71
97              
98             =head1 SYNOPSIS
99              
100             use Log::Dispatch::Base;
101              
102             ...
103              
104             @ISA = qw(Log::Dispatch::Base);
105              
106             =head1 DESCRIPTION
107              
108             Unless you are me, you probably don't need to know what this class does.
109              
110             =for Pod::Coverage .*
111              
112             =head1 SUPPORT
113              
114             Bugs may be submitted at L<https://github.com/houseabsolute/Log-Dispatch/issues>.
115              
116             =head1 SOURCE
117              
118             The source code repository for Log-Dispatch can be found at L<https://github.com/houseabsolute/Log-Dispatch>.
119              
120             =head1 AUTHOR
121              
122             Dave Rolsky <autarch@urth.org>
123              
124             =head1 COPYRIGHT AND LICENSE
125              
126             This software is Copyright (c) 2023 by Dave Rolsky.
127              
128             This is free software, licensed under:
129              
130             The Artistic License 2.0 (GPL Compatible)
131              
132             The full text of the license can be found in the
133             F<LICENSE> file included with this distribution.
134              
135             =cut