← 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:14 2014

Filename/usr/local/lib/site_perl/Log/Channel/Channel.pm
StatementsExecuted 18 statements in 757µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111402µs509µsLog::Channel::Channel::::BEGIN@74Log::Channel::Channel::BEGIN@74
11112µs15µsLog::Channel::Channel::::BEGIN@2Log::Channel::Channel::BEGIN@2
1119µs44µsLog::Channel::Channel::::BEGIN@69Log::Channel::Channel::BEGIN@69
1118µs8µsLog::Channel::Channel::::BEGIN@77Log::Channel::Channel::BEGIN@77
1118µs13µsLog::Channel::Channel::::BEGIN@3Log::Channel::Channel::BEGIN@3
1117µs37µsLog::Channel::Channel::::BEGIN@96Log::Channel::Channel::BEGIN@96
1117µs35µsLog::Channel::Channel::::BEGIN@78Log::Channel::Channel::BEGIN@78
1116µs32µsLog::Channel::Channel::::BEGIN@97Log::Channel::Channel::BEGIN@97
1112µs2µsLog::Channel::Channel::::ENDLog::Channel::Channel::END
0000s0sLog::Channel::Channel::::_initLog::Channel::Channel::_init
0000s0sLog::Channel::Channel::::pass_filtersLog::Channel::Channel::pass_filters
0000s0sLog::Channel::Channel::::writeLog::Channel::Channel::write
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Log::Channel::Channel;
2222µs218µs
# spent 15µs (12+3) within Log::Channel::Channel::BEGIN@2 which was called: # once (12µs+3µs) by Log::Loger::BEGIN@136 at line 2
use strict;
# spent 15µs making 1 call to Log::Channel::Channel::BEGIN@2 # spent 3µs making 1 call to strict::import
3257µs218µ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
use warnings;
# 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
13Log::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
25This is the default implementation of the Log::Channel::Module interface. Channel may
26contain one or more filters, which are used to restrict the messages, that will be
27written to one or more writers. See Log::Filter::(modules) for more information about
28log 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
38Jan Mach
39Cesnet, z.s.p.o
40jan.mach@cesnet.cz
41http://www.cesnet.cz
42
43=head1 COPYRIGHT
44
45This program is free software; you can redistribute
46it and/or modify it under the same terms as Perl itself.
47
48The full text of the license can be found in the
49LICENSE file included with this module.
50
51
52=head1 SEE ALSO
53
54perl(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 ---------------------------------------------------------#
69229µs279µs
# spent 44µs (9+35) within Log::Channel::Channel::BEGIN@69 which was called: # once (9µs+35µs) by Log::Loger::BEGIN@136 at line 69
use Carp;
# spent 44µs making 1 call to Log::Channel::Channel::BEGIN@69 # spent 35µs making 1 call to Exporter::import
70
71#-- Perl CPAN modules ---------------------------------------------------------#
72
73#-- Custom application modules ------------------------------------------------#
742107µs1509µs
# spent 509µs (402+107) within Log::Channel::Channel::BEGIN@74 which was called: # once (402µs+107µs) by Log::Loger::BEGIN@136 at line 74
use Log::Channel::Module;
# spent 509µ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
BEGIN {
78230µs264µs
# spent 35µs (7+29) within Log::Channel::Channel::BEGIN@78 which was called: # once (7µs+29µs) by Log::Loger::BEGIN@136 at line 78
use vars qw($VERSION @ISA);
# spent 35µs making 1 call to Log::Channel::Channel::BEGIN@78 # spent 29µs making 1 call to vars::import
79210µs $VERSION = '0.01';
80 @ISA = ('Log::Channel::Module');
81137µs18µs}
# spent 8µs making 1 call to Log::Channel::Channel::BEGIN@77
82
83
84#-- Module clean-up code (global destructor) ----------------------------------#
8513µs
# spent 2µs within Log::Channel::Channel::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl
END {
86
87}
88
89################################################################################
90#
91# CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION
92#
93################################################################################
94
95#-- Constants -----------------------------------------------------------------#
96227µs267µs
# spent 37µs (7+30) within Log::Channel::Channel::BEGIN@96 which was called: # once (7µs+30µs) by Log::Loger::BEGIN@136 at line 96
use constant ACCEPT => Log::Filter::Module::ACCEPT;
# spent 37µs making 1 call to Log::Channel::Channel::BEGIN@96 # spent 30µs making 1 call to constant::import
972433µs257µ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
use constant REJECT => Log::Filter::Module::REJECT;
# spent 32µs making 1 call to Log::Channel::Channel::BEGIN@97 # spent 25µ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
124sub 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
157sub 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
189sub _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
22612µs1;