Filename | /usr/local/lib/site_perl/Log/Channel/Channel.pm |
Statements | Executed 18 statements in 787µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 424µs | 531µs | BEGIN@74 | Log::Channel::Channel::
1 | 1 | 1 | 13µs | 16µs | BEGIN@2 | Log::Channel::Channel::
1 | 1 | 1 | 8µs | 44µs | BEGIN@69 | Log::Channel::Channel::
1 | 1 | 1 | 8µs | 8µs | BEGIN@77 | Log::Channel::Channel::
1 | 1 | 1 | 8µs | 13µs | BEGIN@3 | Log::Channel::Channel::
1 | 1 | 1 | 7µs | 35µs | BEGIN@78 | Log::Channel::Channel::
1 | 1 | 1 | 7µs | 38µs | BEGIN@96 | Log::Channel::Channel::
1 | 1 | 1 | 6µs | 32µs | BEGIN@97 | Log::Channel::Channel::
1 | 1 | 1 | 3µs | 3µs | END | Log::Channel::Channel::
0 | 0 | 0 | 0s | 0s | _init | Log::Channel::Channel::
0 | 0 | 0 | 0s | 0s | pass_filters | Log::Channel::Channel::
0 | 0 | 0 | 0s | 0s | write | Log::Channel::Channel::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Log::Channel::Channel; | ||||
2 | 2 | 23µs | 2 | 19µs | # spent 16µs (13+3) within Log::Channel::Channel::BEGIN@2 which was called:
# once (13µs+3µs) by Log::Loger::BEGIN@136 at line 2 # spent 16µs making 1 call to Log::Channel::Channel::BEGIN@2
# spent 3µs making 1 call to strict::import |
3 | 2 | 59µs | 2 | 18µs | # spent 13µs (8+5) within Log::Channel::Channel::BEGIN@3 which was called:
# once (8µs+5µs) by Log::Loger::BEGIN@136 at line 3 # spent 13µs making 1 call to Log::Channel::Channel::BEGIN@3
# spent 5µs making 1 call to warnings::import |
4 | |||||
5 | ################################################################################ | ||||
6 | # | ||||
7 | # DOCUMENTATION SECTION | ||||
8 | # | ||||
9 | ################################################################################ | ||||
10 | |||||
11 | =head1 NAME | ||||
12 | |||||
13 | Log::Channel::Channel - Default implementation of the Log::Channel::Module interface | ||||
14 | |||||
15 | =head1 SYNOPSIS | ||||
16 | |||||
17 | use Log::Channel::Channel; | ||||
18 | |||||
19 | my $channel = new Log::Channel::Channel([$filter1,$filter2,$filter3],[$writer1, $writer2]); | ||||
20 | my $channel = new Log::Channel::Channel(undef,[$writer1, $writer2],'accept'); | ||||
21 | $channel->write($source, $severity, $message); | ||||
22 | |||||
23 | =head1 DESCRIPTION | ||||
24 | |||||
25 | This is the default implementation of the Log::Channel::Module interface. Channel may | ||||
26 | contain one or more filters, which are used to restrict the messages, that will be | ||||
27 | written to one or more writers. See Log::Filter::(modules) for more information about | ||||
28 | log filters, and Log::Writer::(modules) for more information about log writers. | ||||
29 | |||||
30 | =head1 USAGE | ||||
31 | |||||
32 | =head1 BUGS | ||||
33 | |||||
34 | =head1 SUPPORT | ||||
35 | |||||
36 | =head1 AUTHOR | ||||
37 | |||||
38 | Jan Mach | ||||
39 | Cesnet, z.s.p.o | ||||
40 | jan.mach@cesnet.cz | ||||
41 | http://www.cesnet.cz | ||||
42 | |||||
43 | =head1 COPYRIGHT | ||||
44 | |||||
45 | This program is free software; you can redistribute | ||||
46 | it and/or modify it under the same terms as Perl itself. | ||||
47 | |||||
48 | The full text of the license can be found in the | ||||
49 | LICENSE file included with this module. | ||||
50 | |||||
51 | |||||
52 | =head1 SEE ALSO | ||||
53 | |||||
54 | perl(1). | ||||
55 | |||||
56 | =head1 FUNCTION REFERENCE | ||||
57 | |||||
58 | =over 4 | ||||
59 | |||||
60 | =cut | ||||
61 | |||||
62 | ################################################################################ | ||||
63 | # | ||||
64 | # INITIALIZATION AND CLEANUP SECTION | ||||
65 | # | ||||
66 | ################################################################################ | ||||
67 | |||||
68 | #-- Perl core modules ---------------------------------------------------------# | ||||
69 | 2 | 27µs | 2 | 80µs | # spent 44µs (8+36) within Log::Channel::Channel::BEGIN@69 which was called:
# once (8µs+36µs) by Log::Loger::BEGIN@136 at line 69 # spent 44µs making 1 call to Log::Channel::Channel::BEGIN@69
# spent 36µs making 1 call to Exporter::import |
70 | |||||
71 | #-- Perl CPAN modules ---------------------------------------------------------# | ||||
72 | |||||
73 | #-- Custom application modules ------------------------------------------------# | ||||
74 | 2 | 117µs | 1 | 531µs | # spent 531µs (424+107) within Log::Channel::Channel::BEGIN@74 which was called:
# once (424µs+107µs) by Log::Loger::BEGIN@136 at line 74 # spent 531µs making 1 call to Log::Channel::Channel::BEGIN@74 |
75 | |||||
76 | #-- Module initializations ----------------------------------------------------# | ||||
77 | # spent 8µs within Log::Channel::Channel::BEGIN@77 which was called:
# once (8µs+0s) by Log::Loger::BEGIN@136 at line 81 | ||||
78 | 2 | 31µs | 2 | 63µs | # spent 35µs (7+28) within Log::Channel::Channel::BEGIN@78 which was called:
# once (7µs+28µs) by Log::Loger::BEGIN@136 at line 78 # spent 35µs making 1 call to Log::Channel::Channel::BEGIN@78
# spent 28µs making 1 call to vars::import |
79 | 2 | 9µs | $VERSION = '0.01'; | ||
80 | @ISA = ('Log::Channel::Module'); | ||||
81 | 1 | 37µs | 1 | 8µs | } # spent 8µs making 1 call to Log::Channel::Channel::BEGIN@77 |
82 | |||||
83 | |||||
84 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
85 | 1 | 3µs | # spent 3µs within Log::Channel::Channel::END which was called:
# once (3µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl | ||
86 | |||||
87 | } | ||||
88 | |||||
89 | ################################################################################ | ||||
90 | # | ||||
91 | # CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION | ||||
92 | # | ||||
93 | ################################################################################ | ||||
94 | |||||
95 | #-- Constants -----------------------------------------------------------------# | ||||
96 | 2 | 27µs | 2 | 68µs | # spent 38µs (7+31) within Log::Channel::Channel::BEGIN@96 which was called:
# once (7µs+31µs) by Log::Loger::BEGIN@136 at line 96 # spent 38µs making 1 call to Log::Channel::Channel::BEGIN@96
# spent 31µs making 1 call to constant::import |
97 | 2 | 453µs | 2 | 57µs | # spent 32µs (6+26) within Log::Channel::Channel::BEGIN@97 which was called:
# once (6µs+26µs) by Log::Loger::BEGIN@136 at line 97 # spent 32µs making 1 call to Log::Channel::Channel::BEGIN@97
# spent 26µs making 1 call to constant::import |
98 | |||||
99 | #-- Static public class variables (our) ---------------------------------------# | ||||
100 | |||||
101 | #-- Static protected class variables (my) -------------------------------------# | ||||
102 | |||||
103 | ################################################################################ | ||||
104 | # | ||||
105 | # IMPLEMENTATION SECTION | ||||
106 | # | ||||
107 | ################################################################################ | ||||
108 | |||||
109 | =item write($$$) [PUBLIC] | ||||
110 | |||||
111 | Usage : $channel->write($source, $severity, $message); | ||||
112 | Purpose : Handle given message | ||||
113 | Returns : 1, if the message passed filters, and 0, if it was rejected | ||||
114 | Arguments : string $source - Name of the source of the message | ||||
115 | enum $severity - Severity in integer or string format (see Log::Core::Essentials for permited values) | ||||
116 | string $message - Message | ||||
117 | Throws : Croaks, if invoked on class, or if given invalid arguments | ||||
118 | Comments : Internally uses pass_filters() method | ||||
119 | See Also : pass_filters() method | ||||
120 | Log::Core::Essentials module for permited severity values | ||||
121 | |||||
122 | =cut | ||||
123 | |||||
124 | sub write($$$) { | ||||
125 | my $self = shift; | ||||
126 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
127 | my ($source, $severity, $message) = @_; | ||||
128 | croak ((caller(0))[3] . ": invalid arguments: $source, $severity, $message\n") unless (defined($source) and defined($severity) and defined($message)); | ||||
129 | |||||
130 | # If the message passes all channel filters | ||||
131 | if ($self->pass_filters($source, $severity, $message)) | ||||
132 | { | ||||
133 | # Write it to all writers in this channel | ||||
134 | foreach my $writer (@{$self->{WRITERS}}) | ||||
135 | { | ||||
136 | $writer->write($source, $severity, $message); | ||||
137 | } | ||||
138 | return 1; | ||||
139 | } | ||||
140 | return 0; | ||||
141 | } | ||||
142 | |||||
143 | =item pass_filters($$$) [PUBLIC] | ||||
144 | |||||
145 | Usage : $channel->pass_filters($source, $severity, $message) | ||||
146 | Purpose : Test, if the given message passess all filters in this channel | ||||
147 | Returns : Log::Filter::Module::ACCEPT on success, Log::Filter::Module::REJECT on failure | ||||
148 | Arguments : string $source - Name of the source of the message | ||||
149 | enum $severity - Severity in integer or string format (see Log::Core::Essentials for permited values) | ||||
150 | string $message - Message | ||||
151 | Throws : Croaks, if invoked on class, or if given invalid arguments | ||||
152 | Comments : Internally used by write() method | ||||
153 | See Also : Log::Core::Essentials module for permited severity values | ||||
154 | |||||
155 | =cut | ||||
156 | |||||
157 | sub pass_filters($$$) { | ||||
158 | my $self = shift; | ||||
159 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
160 | my ($source, $severity, $message) = @_; | ||||
161 | croak ((caller(0))[3] . ": invalid arguments: $source, $severity, $message\n") unless (defined($source) and defined($severity) and defined($message)); | ||||
162 | |||||
163 | my ($result, $continue); | ||||
164 | foreach my $filter (@{$self->{FILTERS}}) | ||||
165 | { | ||||
166 | ($result, $continue) = $filter->accept($source, $severity, $message); | ||||
167 | unless ($continue) | ||||
168 | { | ||||
169 | return $result; | ||||
170 | } | ||||
171 | } | ||||
172 | return $self->{DEFAULT_FILTER_RESULT}; | ||||
173 | } | ||||
174 | |||||
175 | =item _init() [PROTECTED] | ||||
176 | |||||
177 | Usage : Used from constructor as follows: return $self->_init(@_); | ||||
178 | Purpose : Initialize newly created channel instance | ||||
179 | Returns : $self | ||||
180 | Arguments : array reference $filters - Chain of channel filters | ||||
181 | array reference $writers - List of channel writers | ||||
182 | enum $dfr - Default filter chain result (Log::Filter::Module::ACCEPT|REJECT) | ||||
183 | Throws : Croaks, if invoked on class, or if given invalid arguments | ||||
184 | Comments : Internally used by parent`s new() method | ||||
185 | See Also : Log::Filter::Module module for default filter chain result values | ||||
186 | |||||
187 | =cut | ||||
188 | |||||
189 | sub _init { | ||||
190 | my $self = shift; | ||||
191 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
192 | my ($filters, $writers, $dfr) = @_; | ||||
193 | |||||
194 | # Filters may be undefined, it means no filters in the chain at all | ||||
195 | unless (defined($filters)) | ||||
196 | { | ||||
197 | $self->{FILTERS} = []; | ||||
198 | } | ||||
199 | else { | ||||
200 | croak ((caller(0))[3] . ": invalid arguments, filters must be array reference") unless (ref($filters) eq 'ARRAY'); | ||||
201 | map { croak ((caller(0))[3] . ": invalid filter") unless ($_->isa('Log::Filter::Module')); } @{$filters}; | ||||
202 | $self->{FILTERS} = $filters; | ||||
203 | } | ||||
204 | |||||
205 | # Writers must be given, otherwiseit would not make sense | ||||
206 | croak ((caller(0))[3] . ": invalid arguments, writers must be array reference") unless (ref($writers) eq 'ARRAY'); | ||||
207 | croak ((caller(0))[3] . ": invalid arguments, empty writers") unless (scalar @{$writers}); | ||||
208 | map { croak ((caller(0))[3] . ": invalid writer") unless ($_->isa('Log::Writer::Module')); } @{$writers}; | ||||
209 | $self->{WRITERS} = $writers; | ||||
210 | |||||
211 | # Default filter chain result is to reject the message | ||||
212 | $self->{DEFAULT_FILTER_RESULT} = REJECT; | ||||
213 | if (defined($dfr) and uc($dfr) eq 'ACCEPT') | ||||
214 | { | ||||
215 | $self->{DEFAULT_FILTER_RESULT} = ACCEPT; | ||||
216 | } | ||||
217 | return $self; | ||||
218 | } | ||||
219 | |||||
220 | =pod | ||||
221 | |||||
222 | =back | ||||
223 | |||||
224 | =cut | ||||
225 | |||||
226 | 1 | 2µs | 1; |