Filename | /usr/local/lib/site_perl/Log/Filter/Threshold.pm |
Statements | Executed 28 statements in 885µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 13µs | 16µs | BEGIN@2 | Log::Filter::Threshold::
1 | 1 | 1 | 12µs | 12µs | BEGIN@90 | Log::Filter::Threshold::
1 | 1 | 1 | 8µs | 12µs | BEGIN@3 | Log::Filter::Threshold::
1 | 1 | 1 | 8µs | 45µs | BEGIN@81 | Log::Filter::Threshold::
1 | 1 | 1 | 7µs | 37µs | BEGIN@109 | Log::Filter::Threshold::
1 | 1 | 1 | 7µs | 34µs | BEGIN@116 | Log::Filter::Threshold::
1 | 1 | 1 | 7µs | 34µs | BEGIN@91 | Log::Filter::Threshold::
1 | 1 | 1 | 6µs | 36µs | BEGIN@110 | Log::Filter::Threshold::
1 | 1 | 1 | 6µs | 31µs | BEGIN@113 | Log::Filter::Threshold::
1 | 1 | 1 | 6µs | 31µs | BEGIN@112 | Log::Filter::Threshold::
1 | 1 | 1 | 6µs | 31µs | BEGIN@115 | Log::Filter::Threshold::
1 | 1 | 1 | 4µs | 4µs | BEGIN@86 | Log::Filter::Threshold::
1 | 1 | 1 | 4µs | 4µs | BEGIN@87 | Log::Filter::Threshold::
1 | 1 | 1 | 2µs | 2µs | END | Log::Filter::Threshold::
0 | 0 | 0 | 0s | 0s | _init | Log::Filter::Threshold::
0 | 0 | 0 | 0s | 0s | accept | Log::Filter::Threshold::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Log::Filter::Threshold; | ||||
2 | 2 | 22µs | 2 | 19µs | # spent 16µs (13+3) within Log::Filter::Threshold::BEGIN@2 which was called:
# once (13µs+3µs) by Log::Loger::BEGIN@126 at line 2 # spent 16µs making 1 call to Log::Filter::Threshold::BEGIN@2
# spent 3µs making 1 call to strict::import |
3 | 2 | 63µs | 2 | 17µs | # spent 12µs (8+5) within Log::Filter::Threshold::BEGIN@3 which was called:
# once (8µs+5µs) by Log::Loger::BEGIN@126 at line 3 # spent 12µs making 1 call to Log::Filter::Threshold::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::Filter::Threshold - Filter log messages based on minimal and maximal severity threshold | ||||
14 | |||||
15 | =head1 SYNOPSIS | ||||
16 | |||||
17 | use Log::Filter::Threshold; | ||||
18 | |||||
19 | my $filter = new Log::Filter::Threshold('error'); | ||||
20 | |||||
21 | my ($result, $continue) = $filter->accept($source, $severity, $message); | ||||
22 | |||||
23 | =head1 DESCRIPTION | ||||
24 | |||||
25 | This module accepts messages, whose severity level is greater or equal than | ||||
26 | the given threshold. | ||||
27 | |||||
28 | There are two flags, that are altering the avaluation process: | ||||
29 | |||||
30 | i - Invert the result of the evaluation - | ||||
31 | ACCEPT => REJECT | ||||
32 | REJECT => ACCEPT | ||||
33 | r - By default, module`s evaluation is SUFFICIENT - | ||||
34 | ACCEPT => FINISH | ||||
35 | REJECT => CONTINUE | ||||
36 | By setting the flag 'r', module`s evaluation will be REQUIRED - | ||||
37 | ACCEPT => CONTINUE | ||||
38 | REJECT => FINISH | ||||
39 | |||||
40 | Note.: Inverted eveluation is lower than threshold (not lower or equal). | ||||
41 | |||||
42 | =head1 USAGE | ||||
43 | |||||
44 | =head1 BUGS | ||||
45 | |||||
46 | =head1 SUPPORT | ||||
47 | |||||
48 | =head1 AUTHOR | ||||
49 | |||||
50 | Jan Mach | ||||
51 | Cesnet, z.s.p.o | ||||
52 | jan.mach@cesnet.cz | ||||
53 | http://www.cesnet.cz | ||||
54 | |||||
55 | =head1 COPYRIGHT | ||||
56 | |||||
57 | This program is free software; you can redistribute | ||||
58 | it and/or modify it under the same terms as Perl itself. | ||||
59 | |||||
60 | The full text of the license can be found in the | ||||
61 | LICENSE file included with this module. | ||||
62 | |||||
63 | |||||
64 | =head1 SEE ALSO | ||||
65 | |||||
66 | perl(1). | ||||
67 | |||||
68 | =head1 FUNCTION REFERENCE | ||||
69 | |||||
70 | =over 4 | ||||
71 | |||||
72 | =cut | ||||
73 | |||||
74 | ################################################################################ | ||||
75 | # | ||||
76 | # INITIALIZATION AND CLEANUP SECTION | ||||
77 | # | ||||
78 | ################################################################################ | ||||
79 | |||||
80 | #-- Perl core modules ---------------------------------------------------------# | ||||
81 | 2 | 25µs | 2 | 81µs | # spent 45µs (8+37) within Log::Filter::Threshold::BEGIN@81 which was called:
# once (8µs+37µs) by Log::Loger::BEGIN@126 at line 81 # spent 45µs making 1 call to Log::Filter::Threshold::BEGIN@81
# spent 37µs making 1 call to Exporter::import |
82 | |||||
83 | #-- Perl CPAN modules ---------------------------------------------------------# | ||||
84 | |||||
85 | #-- Custom application modules ------------------------------------------------# | ||||
86 | 2 | 19µs | 1 | 4µs | # spent 4µs within Log::Filter::Threshold::BEGIN@86 which was called:
# once (4µs+0s) by Log::Loger::BEGIN@126 at line 86 # spent 4µs making 1 call to Log::Filter::Threshold::BEGIN@86 |
87 | 2 | 26µs | 1 | 4µs | # spent 4µs within Log::Filter::Threshold::BEGIN@87 which was called:
# once (4µs+0s) by Log::Loger::BEGIN@126 at line 87 # spent 4µs making 1 call to Log::Filter::Threshold::BEGIN@87 |
88 | |||||
89 | #-- Module initializations ----------------------------------------------------# | ||||
90 | # spent 12µs within Log::Filter::Threshold::BEGIN@90 which was called:
# once (12µs+0s) by Log::Loger::BEGIN@126 at line 94 | ||||
91 | 2 | 30µs | 2 | 61µs | # spent 34µs (7+27) within Log::Filter::Threshold::BEGIN@91 which was called:
# once (7µs+27µs) by Log::Loger::BEGIN@126 at line 91 # spent 34µs making 1 call to Log::Filter::Threshold::BEGIN@91
# spent 27µs making 1 call to vars::import |
92 | 2 | 12µs | $VERSION = '0.01'; | ||
93 | @ISA = ('Log::Filter::Module'); | ||||
94 | 1 | 37µs | 1 | 12µs | } # spent 12µs making 1 call to Log::Filter::Threshold::BEGIN@90 |
95 | |||||
96 | |||||
97 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
98 | 1 | 2µs | # spent 2µs within Log::Filter::Threshold::END which was called:
# once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl | ||
99 | |||||
100 | } | ||||
101 | |||||
102 | ################################################################################ | ||||
103 | # | ||||
104 | # CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION | ||||
105 | # | ||||
106 | ################################################################################ | ||||
107 | |||||
108 | #-- Constants -----------------------------------------------------------------# | ||||
109 | 2 | 32µs | 2 | 67µs | # spent 37µs (7+30) within Log::Filter::Threshold::BEGIN@109 which was called:
# once (7µs+30µs) by Log::Loger::BEGIN@126 at line 109 # spent 37µs making 1 call to Log::Filter::Threshold::BEGIN@109
# spent 30µs making 1 call to constant::import |
110 | 2 | 26µs | 2 | 66µs | # spent 36µs (6+30) within Log::Filter::Threshold::BEGIN@110 which was called:
# once (6µs+30µs) by Log::Loger::BEGIN@126 at line 110 # spent 36µs making 1 call to Log::Filter::Threshold::BEGIN@110
# spent 30µs making 1 call to constant::import |
111 | |||||
112 | 2 | 33µs | 2 | 56µs | # spent 31µs (6+25) within Log::Filter::Threshold::BEGIN@112 which was called:
# once (6µs+25µs) by Log::Loger::BEGIN@126 at line 112 # spent 31µs making 1 call to Log::Filter::Threshold::BEGIN@112
# spent 25µs making 1 call to constant::import |
113 | 2 | 25µs | 2 | 56µs | # spent 31µs (6+25) within Log::Filter::Threshold::BEGIN@113 which was called:
# once (6µs+25µs) by Log::Loger::BEGIN@126 at line 113 # spent 31µs making 1 call to Log::Filter::Threshold::BEGIN@113
# spent 25µs making 1 call to constant::import |
114 | |||||
115 | 2 | 44µs | 2 | 56µs | # spent 31µs (6+25) within Log::Filter::Threshold::BEGIN@115 which was called:
# once (6µs+25µs) by Log::Loger::BEGIN@126 at line 115 # spent 31µs making 1 call to Log::Filter::Threshold::BEGIN@115
# spent 25µs making 1 call to constant::import |
116 | 2 | 487µs | 2 | 61µs | # spent 34µs (7+27) within Log::Filter::Threshold::BEGIN@116 which was called:
# once (7µs+27µs) by Log::Loger::BEGIN@126 at line 116 # spent 34µs making 1 call to Log::Filter::Threshold::BEGIN@116
# spent 27µs making 1 call to constant::import |
117 | |||||
118 | #-- Static public class variables (our) ---------------------------------------# | ||||
119 | |||||
120 | #-- Static protected class variables (my) -------------------------------------# | ||||
121 | |||||
122 | ################################################################################ | ||||
123 | # | ||||
124 | # IMPLEMENTATION SECTION | ||||
125 | # | ||||
126 | ################################################################################ | ||||
127 | |||||
128 | =item accept($$$) [PUBLIC] | ||||
129 | |||||
130 | Usage : my ($result, $continue) = $filter->accept($source, $severity, $message); | ||||
131 | Purpose : Check, if the filter will accept the given message | ||||
132 | Returns : Array (Log::Filter::Module::ACCEPT|REJECT, Log::Filter::Module::FINISH|CONTINUE) | ||||
133 | Arguments : string $source - Name of the source of the message | ||||
134 | enum $severity - Severity in integer or string format (see Log::Core::Essentials for permited values) | ||||
135 | string $message - Message | ||||
136 | Throws : Croaks, if invoked on class, or if given invalid arguments | ||||
137 | Comments : | ||||
138 | See Also : | ||||
139 | |||||
140 | =cut | ||||
141 | |||||
142 | sub accept($$$) { | ||||
143 | my $self = shift; | ||||
144 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
145 | my ($source, $severity, $message) = @_; | ||||
146 | croak ((caller(0))[3] . ": invalid arguments") unless (defined($source) and defined($severity) and defined($message)); | ||||
147 | |||||
148 | my $resolution; | ||||
149 | my $continue; | ||||
150 | my $level = Log::Core::Essentials->severity_as_int($severity); | ||||
151 | croak ((caller(0))[3] . ": invalid severity value: '$severity'") unless (defined($level)); | ||||
152 | |||||
153 | # Threshold is lower or equal than the severity level of the log message | ||||
154 | if ($self->{THRESHOLD} <= $level) | ||||
155 | { | ||||
156 | unless ($self->{INVERT}) | ||||
157 | { | ||||
158 | $resolution = ACCEPT; | ||||
159 | $continue = ($self->{MODE} eq SUFFICIENT) ? FINISH : CONTINUE; | ||||
160 | } | ||||
161 | else { | ||||
162 | $resolution = REJECT; | ||||
163 | $continue = ($self->{MODE} eq REQUIRED) ? FINISH : CONTINUE; | ||||
164 | } | ||||
165 | return ($resolution, $continue); | ||||
166 | } | ||||
167 | |||||
168 | unless ($self->{INVERT}) | ||||
169 | { | ||||
170 | $resolution = REJECT; | ||||
171 | $continue = ($self->{MODE} eq REQUIRED) ? FINISH : CONTINUE; | ||||
172 | } | ||||
173 | else { | ||||
174 | $resolution = ACCEPT; | ||||
175 | $continue = ($self->{MODE} eq SUFFICIENT) ? FINISH : CONTINUE; | ||||
176 | } | ||||
177 | return ($resolution, $continue); | ||||
178 | } | ||||
179 | |||||
180 | =item _init() [PROTECTED] | ||||
181 | |||||
182 | Usage : Used from constructor as follows: return $self->_init(@_); | ||||
183 | Purpose : Initialize newly created filter instance | ||||
184 | Returns : $self | ||||
185 | Arguments : string $threshold - threshold | ||||
186 | string $flags - flags separated with spaces | ||||
187 | i - invert the result | ||||
188 | r - required | ||||
189 | Throws : Croaks, if invoked on class or invalid arguments given | ||||
190 | Comments : Internally used by parent`s new() method | ||||
191 | See Also : | ||||
192 | |||||
193 | =cut | ||||
194 | |||||
195 | sub _init { | ||||
196 | my $self = shift; | ||||
197 | croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self; | ||||
198 | my ($threshold, $flags) = @_; | ||||
199 | croak ((caller(0))[3] . ": wrong arguments") unless (defined($threshold)); | ||||
200 | |||||
201 | # Convert threshold into it`s corresponding integer value | ||||
202 | $threshold = Log::Core::Essentials->severity_as_int($threshold); | ||||
203 | croak ((caller(0))[3] . ": wrong arguments") unless (defined($threshold)); | ||||
204 | |||||
205 | # Setup threshold | ||||
206 | $self->{THRESHOLD} = $threshold; | ||||
207 | |||||
208 | # Set the engine flags to default falues | ||||
209 | $self->{MODE} = SUFFICIENT; | ||||
210 | $self->{INVERT} = 0; | ||||
211 | |||||
212 | # Setup the aditional engine flags | ||||
213 | if ($flags) | ||||
214 | { | ||||
215 | foreach my $flag (split(/[,; ]+/, $flags)) | ||||
216 | { | ||||
217 | if ($flag =~ /^r$|^req$/) { $self->{MODE} = REQUIRED; } | ||||
218 | elsif ($flag =~ /^i$|^inv$/) { $self->{INVERT} = 1; } | ||||
219 | else { croak ((caller(0))[3] . ": unknown flag '$flag'"); } | ||||
220 | } | ||||
221 | } | ||||
222 | return $self; | ||||
223 | } | ||||
224 | |||||
225 | =pod | ||||
226 | |||||
227 | =back | ||||
228 | |||||
229 | =cut | ||||
230 | |||||
231 | 1 | 2µs | 1; |