← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 09:58:41 2014
Reported on Tue Jun 24 09:59:25 2014

Filename/usr/local/lib/site_perl/Log/Filter/Set.pm
StatementsExecuted 28 statements in 968µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11112µs18µsLog::Filter::Set::::BEGIN@2Log::Filter::Set::BEGIN@2
1118µs8µsLog::Filter::Set::::BEGIN@87Log::Filter::Set::BEGIN@87
1117µs37µsLog::Filter::Set::::BEGIN@105Log::Filter::Set::BEGIN@105
1117µs40µsLog::Filter::Set::::BEGIN@79Log::Filter::Set::BEGIN@79
1116µs11µsLog::Filter::Set::::BEGIN@3Log::Filter::Set::BEGIN@3
1116µs30µsLog::Filter::Set::::BEGIN@111Log::Filter::Set::BEGIN@111
1116µs31µsLog::Filter::Set::::BEGIN@106Log::Filter::Set::BEGIN@106
1116µs34µsLog::Filter::Set::::BEGIN@88Log::Filter::Set::BEGIN@88
1116µs30µsLog::Filter::Set::::BEGIN@108Log::Filter::Set::BEGIN@108
1116µs30µsLog::Filter::Set::::BEGIN@112Log::Filter::Set::BEGIN@112
1116µs30µsLog::Filter::Set::::BEGIN@109Log::Filter::Set::BEGIN@109
1114µs4µsLog::Filter::Set::::BEGIN@84Log::Filter::Set::BEGIN@84
1112µs2µsLog::Filter::Set::::ENDLog::Filter::Set::END
0000s0sLog::Filter::Set::::_field_intLog::Filter::Set::_field_int
0000s0sLog::Filter::Set::::_initLog::Filter::Set::_init
0000s0sLog::Filter::Set::::acceptLog::Filter::Set::accept
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Log::Filter::Set;
2222µs224µs
# spent 18µs (12+6) within Log::Filter::Set::BEGIN@2 which was called: # once (12µs+6µs) by Log::Loger::BEGIN@121 at line 2
use strict;
# spent 18µs making 1 call to Log::Filter::Set::BEGIN@2 # spent 6µs making 1 call to strict::import
3257µs216µs
# spent 11µs (6+5) within Log::Filter::Set::BEGIN@3 which was called: # once (6µs+5µs) by Log::Loger::BEGIN@121 at line 3
use warnings;
# spent 11µs making 1 call to Log::Filter::Set::BEGIN@3 # spent 5µs making 1 call to warnings::import
4
5################################################################################
6#
7# DOCUMENTATION SECTION
8#
9################################################################################
10
11=head1 NAME
12
13Log::Filter::Set - Test given message field for values from certain set
14
15=head1 SYNOPSIS
16
17 use Log::Filter::Set;
18
19 my $filter = new Log::Filter::Set('source','module_a,module_b');
20
21 my ($result, $continue) = $filter->accept($source, $severity, $message);
22
23=head1 DESCRIPTION
24
25This module accepts messages, whose given field`s value is in the given set
26of acceptable values.
27
28There 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=head1 USAGE
41
42=head1 BUGS
43
44=head1 SUPPORT
45
46=head1 AUTHOR
47
48Jan Mach
49Cesnet, z.s.p.o
50jan.mach@cesnet.cz
51http://www.cesnet.cz
52
53=head1 COPYRIGHT
54
55This program is free software; you can redistribute
56it and/or modify it under the same terms as Perl itself.
57
58The full text of the license can be found in the
59LICENSE file included with this module.
60
61
62=head1 SEE ALSO
63
64perl(1).
65
66=head1 FUNCTION REFERENCE
67
68=over 4
69
70=cut
71
72################################################################################
73#
74# INITIALIZATION AND CLEANUP SECTION
75#
76################################################################################
77
78#-- Perl core modules ---------------------------------------------------------#
79224µs273µs
# spent 40µs (7+33) within Log::Filter::Set::BEGIN@79 which was called: # once (7µs+33µs) by Log::Loger::BEGIN@121 at line 79
use Carp;
# spent 40µs making 1 call to Log::Filter::Set::BEGIN@79 # spent 33µs making 1 call to Exporter::import
80
81#-- Perl CPAN modules ---------------------------------------------------------#
82
83#-- Custom application modules ------------------------------------------------#
84233µs14µs
# spent 4µs within Log::Filter::Set::BEGIN@84 which was called: # once (4µs+0s) by Log::Loger::BEGIN@121 at line 84
use Log::Filter::Module;
# spent 4µs making 1 call to Log::Filter::Set::BEGIN@84
85
86#-- Module initializations ----------------------------------------------------#
87
# spent 8µs within Log::Filter::Set::BEGIN@87 which was called: # once (8µs+0s) by Log::Loger::BEGIN@121 at line 91
BEGIN {
88229µs261µs
# spent 34µs (6+28) within Log::Filter::Set::BEGIN@88 which was called: # once (6µs+28µs) by Log::Loger::BEGIN@121 at line 88
use vars qw($VERSION @ISA);
# spent 34µs making 1 call to Log::Filter::Set::BEGIN@88 # spent 27µs making 1 call to vars::import
8928µs $VERSION = '0.01';
90 @ISA = ('Log::Filter::Module');
91143µs18µs}
# spent 8µs making 1 call to Log::Filter::Set::BEGIN@87
92
93#-- Module clean-up code (global destructor) ----------------------------------#
9412µs
# spent 2µs within Log::Filter::Set::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl
END {
95
96}
97
98################################################################################
99#
100# CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION
101#
102################################################################################
103
104#-- Constants -----------------------------------------------------------------#
105230µs267µs
# spent 37µs (7+30) within Log::Filter::Set::BEGIN@105 which was called: # once (7µs+30µs) by Log::Loger::BEGIN@121 at line 105
use constant ACCEPT => Log::Filter::Module::ACCEPT;
# spent 37µs making 1 call to Log::Filter::Set::BEGIN@105 # spent 30µs making 1 call to constant::import
106230µs256µs
# spent 31µs (6+25) within Log::Filter::Set::BEGIN@106 which was called: # once (6µs+25µs) by Log::Loger::BEGIN@121 at line 106
use constant REJECT => Log::Filter::Module::REJECT;
# spent 31µs making 1 call to Log::Filter::Set::BEGIN@106 # spent 25µs making 1 call to constant::import
107
108229µs254µs
# spent 30µs (6+24) within Log::Filter::Set::BEGIN@108 which was called: # once (6µs+24µs) by Log::Loger::BEGIN@121 at line 108
use constant REQUIRED => Log::Filter::Module::REQUIRED;
# spent 30µs making 1 call to Log::Filter::Set::BEGIN@108 # spent 24µs making 1 call to constant::import
109229µs255µs
# spent 30µs (6+25) within Log::Filter::Set::BEGIN@109 which was called: # once (6µs+25µs) by Log::Loger::BEGIN@121 at line 109
use constant SUFFICIENT => Log::Filter::Module::SUFFICIENT;
# spent 30µs making 1 call to Log::Filter::Set::BEGIN@109 # spent 24µs making 1 call to constant::import
110
111228µs253µs
# spent 30µs (6+24) within Log::Filter::Set::BEGIN@111 which was called: # once (6µs+24µs) by Log::Loger::BEGIN@121 at line 111
use constant CONTINUE => Log::Filter::Module::CONTINUE;
# spent 30µs making 1 call to Log::Filter::Set::BEGIN@111 # spent 24µs making 1 call to constant::import
1122596µs254µs
# spent 30µs (6+24) within Log::Filter::Set::BEGIN@112 which was called: # once (6µs+24µs) by Log::Loger::BEGIN@121 at line 112
use constant FINISH => Log::Filter::Module::FINISH;
# spent 30µs making 1 call to Log::Filter::Set::BEGIN@112 # spent 24µs making 1 call to constant::import
113
114#-- Static public class variables (our) ---------------------------------------#
115
116#-- Static protected class variables (my) -------------------------------------#
117
118# Translation table from message fields to indexes
11912µsmy %FIELD2INDEX = ( 'SOURCE' => 0,
120 'SEVERITY' => 1,
121 'MESSAGE' => 2,
122 );
123# Translation table from indexes to message fields
12411µsmy @INDEX2FIELD = ( 'SOURCE',
125 'SEVERITY',
126 'MESSAGE',
127 );
128
129################################################################################
130#
131# IMPLEMENTATION SECTION
132#
133################################################################################
134
135=item accept($$$) [PUBLIC]
136
137 Usage : my ($result, $continue) = $filter->accept($source, $severity, $message);
138 Purpose : Check, if the filter will accept the given message
139 Returns : Array (Log::Filter::Module::ACCEPT|REJECT, Log::Filter::Module::FINISH|CONTINUE)
140 Arguments : string $source - Name of the source of the message
141 enum $severity - Severity in integer or string format (see Log::Core::Essentials for permited values)
142 string $message - Message
143 Throws : Croaks, if invoked on class, or if given invalid arguments
144 Comments :
145 See Also :
146
147=cut
148
149sub accept($$$) {
150 my $self = shift;
151 croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self;
152 my ($source, $severity, $message) = @_;
153 croak ((caller(0))[3] . ": invalid arguments") unless (defined($source) and defined($severity) and defined($message));
154
155 my @fields = @_;
156 my $resolution;
157 my $continue;
158
159 if ($self->{VALUES}->{@fields[$self->{FIELD}]})
160 {
161 unless ($self->{INVERT})
162 {
163 $resolution = ACCEPT;
164 $continue = ($self->{MODE} eq SUFFICIENT) ? FINISH : CONTINUE;
165 }
166 else {
167 $resolution = REJECT;
168 $continue = ($self->{MODE} eq REQUIRED) ? FINISH : CONTINUE;
169 }
170 return ($resolution, $continue);
171 }
172
173 unless ($self->{INVERT})
174 {
175 $resolution = REJECT;
176 $continue = ($self->{MODE} eq REQUIRED) ? FINISH : CONTINUE;
177 }
178 else {
179 $resolution = ACCEPT;
180 $continue = ($self->{MODE} eq SUFFICIENT) ? FINISH : CONTINUE;
181 }
182 return ($resolution, $continue);
183}
184
185=item _init() [PROTECTED]
186
187 Usage : Used from constructor as follows: return $self->_init(@_);
188 Purpose : Initialize newly created filter instance
189 Returns : $self
190 Arguments : enum $field - name of the field to test (source | severity | message)
191 space separated string|array reference $value_set - set of acceptable values
192 string $flags - flags separated with spaces
193 i - invert the result
194 r - required
195 Throws : Croaks, if invoked on class or invalid arguments given
196 Comments : Internally used by parent`s new() method
197 See Also :
198
199=cut
200
201sub _init {
202 my $self = shift;
203 croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self;
204 my ($field, $values, $flags) = @_;
205 croak ((caller(0))[3] . ": invalid arguments") unless ($field and $values);
206
207 # First try to parse and init mandatory arguments
208 $self->{FIELD} = $self->_field_int($field);
209 $self->{VALUES} = {};
210 my @vals;
211 if(ref($values) eq 'ARRAY') { @vals = @{$values}; }
212 else { @vals = split(/[,; ]+/, scalar $values); }
213 foreach my $src (@vals)
214 {
215 $self->{VALUES}->{$src} = 1;
216 }
217 croak ((caller(0))[3] . ": invalid arguments") unless (defined($self->{FIELD}) and scalar keys(%{$self->{VALUES}}));
218
219 # Set the engine flags to default falues
220 $self->{MODE} = SUFFICIENT;
221 $self->{INVERT} = 0;
222
223 # Setup the aditional engine flags
224 if ($flags)
225 {
226 foreach my $flag (split(/[,; ]+/, $flags))
227 {
228 if ($flag =~ /^r$|^req$/) { $self->{MODE} = REQUIRED; }
229 elsif ($flag =~ /^i$|^inv$/) { $self->{INVERT} = 1; }
230 else { croak ((caller(0))[3] . ": unknown flag '$flag'"); }
231 }
232 }
233 return $self;
234}
235
236=item _field_int($) [PROTECTED]
237
238 Usage : $self->_field_int($field)
239 Purpose : Internal method for converting log field to integer index
240 Returns : integer index
241 Arguments : enum $field - name of the field to translate (source | severity | message)
242 Throws : Croaks, if invoked on class
243 Comments : Should be used only internally, used from _init() method
244 See Also :
245
246=cut
247
248sub _field_int {
249 my $self = shift;
250 croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self;
251 my $field = uc(shift);
252
253 # Return undefined value if field was not specified
254 return undef unless (defined($field));
255
256 # Perform conversion only if the argument is not a number
257 if ($field =~ /^$|[^\d]+/)
258 {
259 $field = $FIELD2INDEX{uc($field)};
260 }
261
262 # Return undefined value if the integer is not a valid field value
263 return undef unless (defined($field) and defined($INDEX2FIELD[$field]));
264
265 # Othervise return valid value
266 return $field;
267}
268
269
270=pod
271
272=back
273
274=cut
275
27614µs1;