← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 10:04:38 2014
Reported on Tue Jun 24 10:05:21 2014

Filename/usr/local/lib/site_perl/Log/Filter/Re.pm
StatementsExecuted 28 statements in 970µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11125µs28µsLog::Filter::Re::::BEGIN@2Log::Filter::Re::BEGIN@2
1119µs34µsLog::Filter::Re::::BEGIN@108Log::Filter::Re::BEGIN@108
1118µs8µsLog::Filter::Re::::BEGIN@89Log::Filter::Re::BEGIN@89
1118µs33µsLog::Filter::Re::::BEGIN@110Log::Filter::Re::BEGIN@110
1117µs12µsLog::Filter::Re::::BEGIN@3Log::Filter::Re::BEGIN@3
1117µs31µsLog::Filter::Re::::BEGIN@114Log::Filter::Re::BEGIN@114
1117µs41µsLog::Filter::Re::::BEGIN@81Log::Filter::Re::BEGIN@81
1117µs38µsLog::Filter::Re::::BEGIN@107Log::Filter::Re::BEGIN@107
1117µs31µsLog::Filter::Re::::BEGIN@111Log::Filter::Re::BEGIN@111
1117µs40µsLog::Filter::Re::::BEGIN@90Log::Filter::Re::BEGIN@90
1116µs30µsLog::Filter::Re::::BEGIN@113Log::Filter::Re::BEGIN@113
1115µs5µsLog::Filter::Re::::BEGIN@86Log::Filter::Re::BEGIN@86
1112µs2µsLog::Filter::Re::::ENDLog::Filter::Re::END
0000s0sLog::Filter::Re::::_field_intLog::Filter::Re::_field_int
0000s0sLog::Filter::Re::::_initLog::Filter::Re::_init
0000s0sLog::Filter::Re::::acceptLog::Filter::Re::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::Re;
2223µs231µs
# spent 28µs (25+3) within Log::Filter::Re::BEGIN@2 which was called: # once (25µs+3µs) by Log::Loger::BEGIN@124 at line 2
use strict;
# spent 28µs making 1 call to Log::Filter::Re::BEGIN@2 # spent 3µs making 1 call to strict::import
3262µs217µs
# spent 12µs (7+5) within Log::Filter::Re::BEGIN@3 which was called: # once (7µs+5µs) by Log::Loger::BEGIN@124 at line 3
use warnings;
# spent 12µs making 1 call to Log::Filter::Re::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::Re - Test given message field for values according the given PCRE patterns
14
15=head1 SYNOPSIS
16
17 use Log::Filter::Re;
18
19 my $filter = new Log::Filter::Re('source','modul.*[a|b]');
20 my $filter = new Log::Filter::Re('severity','error');
21 my $filter = new Log::Filter::Re('message',['127.0.0.1','^notice'],'i r');
22
23 my ($result, $continue) = $filter->accept($source, $severity, $message);
24
25=head1 DESCRIPTION
26
27This module accepts messages, whose given field comply to the at least one of the given
28PCRE patterns.
29
30There are two flags, that are altering the avaluation process:
31
32 i - Invert the result of the evaluation -
33 ACCEPT => REJECT
34 REJECT => ACCEPT
35 r - By default, module`s evaluation is SUFFICIENT -
36 ACCEPT => FINISH
37 REJECT => CONTINUE
38 By setting the flag 'r', module`s evaluation will be REQUIRED -
39 ACCEPT => CONTINUE
40 REJECT => FINISH
41
42=head1 USAGE
43
44=head1 BUGS
45
46=head1 SUPPORT
47
48=head1 AUTHOR
49
50Jan Mach
51Cesnet, z.s.p.o
52jan.mach@cesnet.cz
53http://www.cesnet.cz
54
55=head1 COPYRIGHT
56
57This program is free software; you can redistribute
58it and/or modify it under the same terms as Perl itself.
59
60The full text of the license can be found in the
61LICENSE file included with this module.
62
63
64=head1 SEE ALSO
65
66perl(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 ---------------------------------------------------------#
81224µs275µs
# spent 41µs (7+34) within Log::Filter::Re::BEGIN@81 which was called: # once (7µs+34µs) by Log::Loger::BEGIN@124 at line 81
use Carp;
# spent 41µs making 1 call to Log::Filter::Re::BEGIN@81 # spent 34µs making 1 call to Exporter::import
82
83#-- Perl CPAN modules ---------------------------------------------------------#
84
85#-- Custom application modules ------------------------------------------------#
86230µs15µs
# spent 5µs within Log::Filter::Re::BEGIN@86 which was called: # once (5µs+0s) by Log::Loger::BEGIN@124 at line 86
use Log::Filter::Module;
# spent 5µs making 1 call to Log::Filter::Re::BEGIN@86
87
88#-- Module initializations ----------------------------------------------------#
89
# spent 8µs within Log::Filter::Re::BEGIN@89 which was called: # once (8µs+0s) by Log::Loger::BEGIN@124 at line 93
BEGIN {
90230µs274µs
# spent 40µs (7+34) within Log::Filter::Re::BEGIN@90 which was called: # once (7µs+34µs) by Log::Loger::BEGIN@124 at line 90
use vars qw($VERSION @ISA);
# spent 40µs making 1 call to Log::Filter::Re::BEGIN@90 # spent 34µs making 1 call to vars::import
9128µs $VERSION = '0.01';
92 @ISA = ('Log::Filter::Module');
93136µs18µs}
# spent 8µs making 1 call to Log::Filter::Re::BEGIN@89
94
95#-- Module clean-up code (global destructor) ----------------------------------#
9612µs
# spent 2µs within Log::Filter::Re::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl
END {
97
98}
99
100################################################################################
101#
102# CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION
103#
104################################################################################
105
106#-- Constants -----------------------------------------------------------------#
107227µs268µs
# spent 38µs (7+31) within Log::Filter::Re::BEGIN@107 which was called: # once (7µs+31µs) by Log::Loger::BEGIN@124 at line 107
use constant ACCEPT => Log::Filter::Module::ACCEPT;
# spent 38µs making 1 call to Log::Filter::Re::BEGIN@107 # spent 31µs making 1 call to constant::import
108231µs259µs
# spent 34µs (9+25) within Log::Filter::Re::BEGIN@108 which was called: # once (9µs+25µs) by Log::Loger::BEGIN@124 at line 108
use constant REJECT => Log::Filter::Module::REJECT;
# spent 34µs making 1 call to Log::Filter::Re::BEGIN@108 # spent 25µs making 1 call to constant::import
109
110228µs259µs
# spent 33µs (8+26) within Log::Filter::Re::BEGIN@110 which was called: # once (8µs+26µs) by Log::Loger::BEGIN@124 at line 110
use constant REQUIRED => Log::Filter::Module::REQUIRED;
# spent 33µs making 1 call to Log::Filter::Re::BEGIN@110 # spent 26µs making 1 call to constant::import
111225µs255µs
# spent 31µs (7+24) within Log::Filter::Re::BEGIN@111 which was called: # once (7µs+24µs) by Log::Loger::BEGIN@124 at line 111
use constant SUFFICIENT => Log::Filter::Module::SUFFICIENT;
# spent 31µs making 1 call to Log::Filter::Re::BEGIN@111 # spent 24µs making 1 call to constant::import
112
113225µs254µs
# spent 30µs (6+24) within Log::Filter::Re::BEGIN@113 which was called: # once (6µs+24µs) by Log::Loger::BEGIN@124 at line 113
use constant CONTINUE => Log::Filter::Module::CONTINUE;
# spent 30µs making 1 call to Log::Filter::Re::BEGIN@113 # spent 24µs making 1 call to constant::import
1142612µs254µs
# spent 31µs (7+24) within Log::Filter::Re::BEGIN@114 which was called: # once (7µs+24µs) by Log::Loger::BEGIN@124 at line 114
use constant FINISH => Log::Filter::Module::FINISH;
# spent 31µs making 1 call to Log::Filter::Re::BEGIN@114 # spent 24µs making 1 call to constant::import
115
116#-- Static public class variables (our) ---------------------------------------#
117
118#-- Static protected class variables (my) -------------------------------------#
119
120# Translation table from message fields to indexes
12112µsmy %FIELD2INDEX = ( 'SOURCE' => 0,
122 'SEVERITY' => 1,
123 'MESSAGE' => 2,
124 );
125# Translation table from indexes to message fields
12611µsmy @INDEX2FIELD = ( 'SOURCE',
127 'SEVERITY',
128 'MESSAGE',
129 );
130
131################################################################################
132#
133# IMPLEMENTATION SECTION
134#
135################################################################################
136
137=item accept($$$) [PUBLIC]
138
139 Usage : my ($result, $continue) = $filter->accept($source, $severity, $message);
140 Purpose : Check, if the filter will accept the given message
141 Returns : Array (Log::Filter::Module::ACCEPT|REJECT, Log::Filter::Module::FINISH|CONTINUE)
142 Arguments : string $source - Name of the source of the message
143 enum $severity - Severity in integer or string format (see Log::Core::Essentials for permited values)
144 string $message - Message
145 Throws : Croaks, if invoked on class, or if given invalid arguments
146 Comments :
147 See Also :
148
149=cut
150
151sub accept($$$) {
152 my $self = shift;
153 croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self;
154 my ($source, $severity, $message) = @_;
155 croak ((caller(0))[3] . ": invalid arguments") unless (defined($source) and defined($severity) and defined($message));
156
157 my @fields = @_;
158 my $resolution;
159 my $continue;
160
161 # Walk through all PCRE patterns
162 foreach my $pattern (@{$self->{PATTERNS}})
163 {
164 # If the given field complies to the current pattern
165 if (@fields[$self->{FIELD}] =~ /$pattern/)
166 {
167 unless ($self->{INVERT})
168 {
169 $resolution = ACCEPT;
170 $continue = ($self->{MODE} eq SUFFICIENT) ? FINISH : CONTINUE;
171 }
172 else {
173 $resolution = REJECT;
174 $continue = ($self->{MODE} eq REQUIRED) ? FINISH : CONTINUE;
175 }
176 return ($resolution, $continue);
177 }
178 }
179
180 unless ($self->{INVERT})
181 {
182 $resolution = REJECT;
183 $continue = ($self->{MODE} eq REQUIRED) ? FINISH : CONTINUE;
184 }
185 else {
186 $resolution = ACCEPT;
187 $continue = ($self->{MODE} eq SUFFICIENT) ? FINISH : CONTINUE;
188 }
189 return ($resolution, $continue);
190}
191
192=item _init() [PROTECTED]
193
194 Usage : Used from constructor as follows: return $self->_init(@_);
195 Purpose : Initialize newly created filter instance
196 Returns : $self
197 Arguments : enum $field - name of the field to test (source | severity | message)
198 array reference $patterns - list of PCRE patterns
199 string $flags - flags separated with spaces
200 i - invert the result
201 r - required
202 Throws : Croaks, if invoked on class or invalid arguments given
203 Comments : Internally used by parent`s new() method
204 See Also : Log::Filter::Re->_init() method
205
206=cut
207
208sub _init {
209 my $self = shift;
210 croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self;
211 my ($field, $patterns, $flags) = @_;
212 croak ((caller(0))[3] . ": invalid arguments") unless ($field and $patterns);
213
214 # First try to parse and init mandatory arguments
215 $self->{FIELD} = $self->_field_int($field);
216 $self->{PATTERNS} = [];
217 my @ptrns;
218 if(ref($patterns) eq 'ARRAY') { push(@ptrns, @{$patterns}); }
219 else { push(@ptrns, $patterns); }
220 push(@{$self->{PATTERNS}}, map { qr/$_/ } @ptrns);
221 croak ((caller(0))[3] . ": invalid arguments") unless (defined($self->{FIELD}) and scalar @{$self->{PATTERNS}});
222
223 # Set the engine flags to default falues
224 $self->{MODE} = Log::Filter::Module::SUFFICIENT;
225 $self->{INVERT} = 0;
226
227 # Setup the aditional engine flags
228 if ($flags)
229 {
230 foreach my $flag (split(/[,; ]+/, $flags))
231 {
232 if ($flag =~ /^r$|^req$/) { $self->{MODE} = Log::Filter::Module::REQUIRED; }
233 elsif ($flag =~ /^i$|^inv$/) { $self->{INVERT} = 1; }
234 else { croak ((caller(0))[3] . ": unknown flag '$flag'"); }
235 }
236 }
237 return $self;
238}
239
240=item _field_int($) [PROTECTED]
241
242 Usage : $self->_field_int($field)
243 Purpose : Internal method for converting log field to integer index
244 Returns : integer index
245 Arguments : enum $field - name of the field to translate (source | severity | message)
246 Throws : Croaks, if invoked on class
247 Comments : Should be used only internally, used from _init() method
248 See Also :
249
250=cut
251
252sub _field_int($) {
253 my $self = shift;
254 croak ((caller(0))[3] . ": instance method invoked on class") unless ref $self;
255 my $field = uc(shift);
256
257 # Return undefined value if field was not specified
258 return undef unless (defined($field));
259
260 # Perform conversion only if the argument is not a number
261 if ($field =~ /^$|[^\d]+/)
262 {
263 $field = $FIELD2INDEX{uc($field)};
264 }
265
266 # Return undefined value if the integer is not a valid field value
267 return undef unless (defined($field) and defined($INDEX2FIELD[$field]));
268
269 # Othervise return valid value
270 return $field;
271}
272
273
274=pod
275
276=back
277
278=cut
279
28014µs1;