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

Filename/usr/local/lib/site_perl/Log/Loger.pm
StatementsExecuted 129 statements in 3.53ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1111.28ms2.59msLog::Loger::::BEGIN@130Log::Loger::BEGIN@130
111988µs1.70msLog::Loger::::BEGIN@116Log::Loger::BEGIN@116
111986µs1.29msLog::Loger::::BEGIN@121Log::Loger::BEGIN@121
111964µs1.28msLog::Loger::::BEGIN@124Log::Loger::BEGIN@124
111914µs14.2msLog::Loger::::BEGIN@129Log::Loger::BEGIN@129
111863µs7.59msLog::Loger::::BEGIN@133Log::Loger::BEGIN@133
111831µs1.15msLog::Loger::::BEGIN@126Log::Loger::BEGIN@126
111719µs1.41msLog::Loger::::BEGIN@136Log::Loger::BEGIN@136
111448µs740µsLog::Loger::::BEGIN@131Log::Loger::BEGIN@131
111378µs533µsLog::Loger::::BEGIN@132Log::Loger::BEGIN@132
111372µs495µsLog::Loger::::BEGIN@120Log::Loger::BEGIN@120
111368µs1.25msLog::Loger::::BEGIN@119Log::Loger::BEGIN@119
111330µs478µsLog::Loger::::BEGIN@125Log::Loger::BEGIN@125
111317µs434µsLog::Loger::::BEGIN@123Log::Loger::BEGIN@123
111304µs425µsLog::Loger::::BEGIN@122Log::Loger::BEGIN@122
52144µs97µsLog::Loger::::logLog::Loger::log
33115µs64µsLog::Loger::::debugLog::Loger::debug
11113µs20µsLog::Loger::::BEGIN@2Log::Loger::BEGIN@2
22113µs60µsLog::Loger::::infoLog::Loger::info
1119µs35µsLog::Loger::::BEGIN@109Log::Loger::BEGIN@109
1117µs50µsLog::Loger::::BEGIN@108Log::Loger::BEGIN@108
1117µs26µsLog::Loger::::BEGIN@140Log::Loger::BEGIN@140
1116µs11µsLog::Loger::::BEGIN@3Log::Loger::BEGIN@3
1113µs3µsLog::Loger::::BEGIN@139Log::Loger::BEGIN@139
1112µs2µsLog::Loger::::ENDLog::Loger::END
0000s0sLog::Loger::::alertLog::Loger::alert
0000s0sLog::Loger::::channelLog::Loger::channel
0000s0sLog::Loger::::channel_countLog::Loger::channel_count
0000s0sLog::Loger::::channel_removeLog::Loger::channel_remove
0000s0sLog::Loger::::critLog::Loger::crit
0000s0sLog::Loger::::emailLog::Loger::email
0000s0sLog::Loger::::emergLog::Loger::emerg
0000s0sLog::Loger::::errorLog::Loger::error
0000s0sLog::Loger::::filterLog::Loger::filter
0000s0sLog::Loger::::get_debugLog::Loger::get_debug
0000s0sLog::Loger::::log_carpLog::Loger::log_carp
0000s0sLog::Loger::::log_cluckLog::Loger::log_cluck
0000s0sLog::Loger::::log_confessLog::Loger::log_confess
0000s0sLog::Loger::::log_croakLog::Loger::log_croak
0000s0sLog::Loger::::log_dieLog::Loger::log_die
0000s0sLog::Loger::::log_exitLog::Loger::log_exit
0000s0sLog::Loger::::log_warnLog::Loger::log_warn
0000s0sLog::Loger::::newLog::Loger::new
0000s0sLog::Loger::::noticeLog::Loger::notice
0000s0sLog::Loger::::onLog::Loger::on
0000s0sLog::Loger::::warnLog::Loger::warn
0000s0sLog::Loger::::writerLog::Loger::writer
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Log::Loger;
2223µs226µs
# spent 20µs (13+6) within Log::Loger::BEGIN@2 which was called: # once (13µs+6µs) by Mentat::Storage::Mongo::BEGIN@170 at line 2
use strict;
# spent 20µs making 1 call to Log::Loger::BEGIN@2 # spent 6µs making 1 call to strict::import
3278µs216µs
# spent 11µs (6+5) within Log::Loger::BEGIN@3 which was called: # once (6µs+5µs) by Mentat::Storage::Mongo::BEGIN@170 at line 3
use warnings;
# spent 11µs making 1 call to Log::Loger::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::Loger - Powerful, but lightweight and easy to use Perl loging framework
14
15=head1 SYNOPSIS
16
17 use Log::Loger;
18
19 # Usage through static methods
20 Log::Loger->filter('filter1','threshold','WARNING','r');
21 Log::Loger->filter('filter2','source','module_a, module_b');
22 Log::Loger->writer('writer1','std');
23 my $ch_id = Log::Loger->channel('filter1,filter2','writer1');
24 Log::Loger->channel_remove($ch_id);
25
26 Log::Loger->log('source', 'ERROR', 'message');
27 Log::Loger->log_warn('source', 'ERROR', 'message');
28 Log::Loger->log_die('source', 'ERROR', 'message');
29 Log::Loger->log_exit('source', 'ERROR', 'message');
30
31 # Quickly turn on the logging of all messages to STDERR
32 Log::Loger->on();
33
34 # Usage through instance methods
35 my $instance = new Log::Loger();
36
37 $instance->filter('filter1','threshold','WARNING','r');
38 $instance->filter('filter2','source','module_a, module_b');
39 $instance->filter('filter3','message','9');
40 $instance->writer('writer1','std');
41 my $ch_id = $instance->channel(['filter1','filter2','filter3'],['writer1']);
42 $instance->channel_remove($ch_id);
43
44 $instance->log('source', 'ERROR', 'message');
45 $instance->log_warn('source', 'ERROR', 'message');
46 $instance->log_die('source', 'ERROR', 'message');
47 $instance->log_exit('source', 'ERROR', 'message');
48
49 # Quickly turn on the logging of all messages to STDERR
50 $instance->on();
51
52=head1 DESCRIPTION
53
54This log framework is designed to be easy to use and extend to your needs.
55It may be used through static or instance methods. The design was inspired
56by syslog-ng loger.
57
58All incoming messages are directed to the CHANNELS. CHANNELS are composed
59of one or more chained FILTERS and one or more WRITERS. When message
60enters the CHANNEL, all FILTERS are consulted in order to determine, if the
61message will be passed to the WRITERS to be written to the destinations.
62
63By default, FILTERS work in the SUFFICIENT mode - their result is authoritative
64and if the message passes particular filter, result is sufficient and no
65other filters are considered. If the message is rejected, default channel
66policy aplies. This default behaviour may be altered using the 'r' flag
67passed to most of the filters. In the REQUIRED mode, if the message is rejected,
68result is authoritative and no more filters are considered. If the message
69passes, next filter in row is considered.
70
71Most of the filters also accept the 'i' flag, which inverts the result. It means,
72that the filter will return REJECT instead of ACCEPT and vice versa. Please
73see the documentation of particular filter for more information.
74
75=head1 AUTHOR
76
77 Jan Mach
78 Cesnet, z.s.p.o
79 jan.mach@cesnet.cz
80 http://www.cesnet.cz
81
82=head1 COPYRIGHT
83
84This program is free software; you can redistribute
85it and/or modify it under the same terms as Perl itself.
86
87The full text of the license can be found in the
88LICENSE file included with this module.
89
90
91=head1 SEE ALSO
92
93perl(1).
94
95=head1 FUNCTION REFERENCE
96
97=over 4
98
99=cut
100
101#*******************************************************************************
102#
103# INITIALIZATION AND CLEANUP SECTION
104#
105#*******************************************************************************
106
107#-- Perl core modules ---------------------------------------------------------#
108224µs293µs
# spent 50µs (7+43) within Log::Loger::BEGIN@108 which was called: # once (7µs+43µs) by Mentat::Storage::Mongo::BEGIN@170 at line 108
use Carp qw(carp croak cluck confess longmess);
# spent 50µs making 1 call to Log::Loger::BEGIN@108 # spent 43µs making 1 call to Exporter::import
109227µs261µs
# spent 35µs (9+26) within Log::Loger::BEGIN@109 which was called: # once (9µs+26µs) by Mentat::Storage::Mongo::BEGIN@170 at line 109
use Data::Dumper;
# spent 35µs making 1 call to Log::Loger::BEGIN@109 # spent 26µs making 1 call to Exporter::import
110
111#-- Perl CPAN modules ---------------------------------------------------------#
112
113#-- Custom application modules ------------------------------------------------#
114
115# Core logging contants and utilities
1162113µs11.70ms
# spent 1.70ms (988µs+710µs) within Log::Loger::BEGIN@116 which was called: # once (988µs+710µs) by Mentat::Storage::Mongo::BEGIN@170 at line 116
use Log::Core::Essentials;
# spent 1.70ms making 1 call to Log::Loger::BEGIN@116
117
118# Log filtering modules
1192106µs11.25ms
# spent 1.25ms (368µs+879µs) within Log::Loger::BEGIN@119 which was called: # once (368µs+879µs) by Mentat::Storage::Mongo::BEGIN@170 at line 119
use Log::Filter::All;
# spent 1.25ms making 1 call to Log::Loger::BEGIN@119
120293µs1495µs
# spent 495µs (372+124) within Log::Loger::BEGIN@120 which was called: # once (372µs+124µs) by Mentat::Storage::Mongo::BEGIN@170 at line 120
use Log::Filter::None;
# spent 495µs making 1 call to Log::Loger::BEGIN@120
1212103µs11.29ms
# spent 1.29ms (986µs+302µs) within Log::Loger::BEGIN@121 which was called: # once (986µs+302µs) by Mentat::Storage::Mongo::BEGIN@170 at line 121
use Log::Filter::Set;
# spent 1.29ms making 1 call to Log::Loger::BEGIN@121
122299µs1425µs
# spent 425µs (304+121) within Log::Loger::BEGIN@122 which was called: # once (304µs+121µs) by Mentat::Storage::Mongo::BEGIN@170 at line 122
use Log::Filter::Source;
# spent 425µs making 1 call to Log::Loger::BEGIN@122
123298µs1434µs
# spent 434µs (317+117) within Log::Loger::BEGIN@123 which was called: # once (317µs+117µs) by Mentat::Storage::Mongo::BEGIN@170 at line 123
use Log::Filter::Severity;
# spent 434µs making 1 call to Log::Loger::BEGIN@123
124294µs11.28ms
# spent 1.28ms (964µs+317µs) within Log::Loger::BEGIN@124 which was called: # once (964µs+317µs) by Mentat::Storage::Mongo::BEGIN@170 at line 124
use Log::Filter::Re;
# spent 1.28ms making 1 call to Log::Loger::BEGIN@124
1252109µs1478µs
# spent 478µs (330+149) within Log::Loger::BEGIN@125 which was called: # once (330µs+149µs) by Mentat::Storage::Mongo::BEGIN@170 at line 125
use Log::Filter::Message;
# spent 478µs making 1 call to Log::Loger::BEGIN@125
126299µs11.15ms
# spent 1.15ms (831µs+323µs) within Log::Loger::BEGIN@126 which was called: # once (831µs+323µs) by Mentat::Storage::Mongo::BEGIN@170 at line 126
use Log::Filter::Threshold;
# spent 1.15ms making 1 call to Log::Loger::BEGIN@126
127
128# Log writing modules
1292100µs114.2ms
# spent 14.2ms (914µs+13.3) within Log::Loger::BEGIN@129 which was called: # once (914µs+13.3ms) by Mentat::Storage::Mongo::BEGIN@170 at line 129
use Log::Writer::Email;
# spent 14.2ms making 1 call to Log::Loger::BEGIN@129
1302105µs12.59ms
# spent 2.59ms (1.28+1.32) within Log::Loger::BEGIN@130 which was called: # once (1.28ms+1.32ms) by Mentat::Storage::Mongo::BEGIN@170 at line 130
use Log::Writer::Handle;
# spent 2.59ms making 1 call to Log::Loger::BEGIN@130
131298µs1740µs
# spent 740µs (448+292) within Log::Loger::BEGIN@131 which was called: # once (448µs+292µs) by Mentat::Storage::Mongo::BEGIN@170 at line 131
use Log::Writer::File;
# spent 740µs making 1 call to Log::Loger::BEGIN@131
132296µs1533µs
# spent 533µs (378+155) within Log::Loger::BEGIN@132 which was called: # once (378µs+155µs) by Mentat::Storage::Mongo::BEGIN@170 at line 132
use Log::Writer::Std;
# spent 533µs making 1 call to Log::Loger::BEGIN@132
133297µs17.59ms
# spent 7.59ms (863µs+6.73) within Log::Loger::BEGIN@133 which was called: # once (863µs+6.73ms) by Mentat::Storage::Mongo::BEGIN@170 at line 133
use Log::Writer::Syslog;
# spent 7.59ms making 1 call to Log::Loger::BEGIN@133
134
135# Log channel modules
1362117µs11.41ms
# spent 1.41ms (719µs+693µs) within Log::Loger::BEGIN@136 which was called: # once (719µs+693µs) by Mentat::Storage::Mongo::BEGIN@170 at line 136
use Log::Channel::Channel;
# spent 1.41ms making 1 call to Log::Loger::BEGIN@136
137
138#-- Module initializations ----------------------------------------------------#
139
# spent 3µs within Log::Loger::BEGIN@139 which was called: # once (3µs+0s) by Mentat::Storage::Mongo::BEGIN@170 at line 142
BEGIN {
140224µs246µs
# spent 26µs (7+20) within Log::Loger::BEGIN@140 which was called: # once (7µs+20µs) by Mentat::Storage::Mongo::BEGIN@170 at line 140
use vars qw($VERSION);
# spent 26µs making 1 call to Log::Loger::BEGIN@140 # spent 20µs making 1 call to vars::import
14113µs $VERSION = '0.01';
14211.74ms13µs}
# spent 3µs making 1 call to Log::Loger::BEGIN@139
143
144#-- Module clean-up code (global destructor) ----------------------------------#
14513µs
# spent 2µs within Log::Loger::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl
END {
146
147}
148
149#*******************************************************************************
150#
151# CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION
152#
153#*******************************************************************************
154
155#-- Constants -----------------------------------------------------------------#
156
157#-- Static public class variables (our) ---------------------------------------#
158
159#-- Static protected class variables (my) -------------------------------------#
160
161# Storage for global writers, filters and channel configurations
1621800nsmy $WRITERS = {};
1631200nsmy $WRITER_TYPES = {};
1641200nsmy $FILTERS = {};
1651200nsmy $CHANNELS = {};
1661300nsmy $CH_QUEUE = [];
167
168# Sequential indentifiers
1691200nsmy $SEQ = 0;
170
171#*******************************************************************************
172#
173# IMPLEMENTATION SECTION
174#
175#*******************************************************************************
176
177=item new() [PUBLIC,STATIC]
178
179 Usage : my $loger = Log::Loger->new();
180 Purpose : Create new instance of log loger
181 Returns : Reference to the new instance
182 Arguments : None
183 Throws : Croaks if invoked on object
184 Comments : Instance is initialized through filter(), writer() and channel() methods
185 See Also : filter(), writer(), channel() methods
186
187=cut
188
189sub new()
190{
191 my $class = shift;
192 croak ((caller(0))[3] . ": class method invoked on object") if ref $class;
193
194 my $self = bless ({}, $class);
195 $self->{WRITERS} = {};
196 $self->{WRITER_TYPES} = {};
197 $self->{FILTERS} = {};
198 $self->{CHANNELS} = {};
199 $self->{CH_QUEUE} = [];
200 $self->{SEQ} = 0;
201 return $self;
202}
203
204=item on() [PUBLIC,HYBRID]
205
206 Usage : $loger->on();
207 Log::Loger->on();
208 Purpose : Quickly turn on logging of all messages to the STDERR
209 Arguments : None
210 Returns : Nothing
211 Throws : Nothing
212 Comments : Hybrid method, may be called on class or instance
213
214=cut
215
216sub on()
217{
218 my $invocant = shift;
219
220 # Default writer writes to STDERR
221 $invocant->writer('writer_on','std');
222 # Channel without filter accepting all messages
223 $invocant->channel(undef,'writer_on','ACCEPT');
224}
225
226=item get_debug() [PUBLIC,STATIC]
227
228 Usage : my ($writers, $filters, $channel) = Log::Loger->get_debug();
229 Purpose : Get references to the writers, filters and channels
230 Returns : References to the the writers, filters and channels
231 Arguments : None
232 Throws : Croaks if invoked on object
233
234=cut
235
236sub get_debug()
237{
238 my $class = shift;
239 croak ((caller(0))[3] . ": class method invoked on object") if ref $class;
240 return ($WRITERS, $FILTERS, $CHANNELS, $CH_QUEUE);
241}
242
243=item channel($$;$) [PUBLIC,HYBRID]
244
245 Usage : Log::Loger->channel('filter1,filter2','writer1'); or
246 $instance->channel(['filter1','filter2','filter3'],['writer1']);
247 Purpose : Create new channel from given filters and writers
248 Returns : Nothing
249 Arguments : space separated string | array reference $filters - identifiers of the filters
250 space separated string | array reference $writers - identifiers of the writers
251 enum $dfr - default filter chain result (see. Log::Channel::Channel for details)
252 Throws : Dies, if given invalid arguments
253
254=cut
255
256sub channel($$;$)
257{
258 my $invocant = shift;
259 my ($filters, $writers, $dfr) = @_;
260 croak ((caller(0))[3] . ": invalid arguments") unless (defined($writers));
261
262 my $filters_available = (ref $invocant) ? $invocant->{FILTERS} : $FILTERS;
263 my $writers_available = (ref $invocant) ? $invocant->{WRITERS} : $WRITERS;
264
265 my $channel_filters = [];
266 my $channel_writers = [];
267
268 # Filter identifiers may be given in array
269 if (ref($filters) eq 'ARRAY')
270 {
271 map { croak ((caller(0))[3] . ": invalid filter id" . ((defined($_))?": '$_'":'')) unless $filters_available->{$_}; } @{$filters};
272 map { push(@$channel_filters, $filters_available->{$_} ); } @{$filters};
273 }
274 # Or as space separated string
275 elsif ($filters)
276 {
277 map { croak ((caller(0))[3] . ": invalid filter id" . ((defined($_))?": '$_'":'')) unless $filters_available->{$_}; } split(/[,; ]+/, $filters);
278 map { push(@$channel_filters, $filters_available->{$_} ); } split(/[,; ]+/, $filters);
279 }
280
281 # Writers identifiers may be given in array
282 if (ref($writers) eq 'ARRAY')
283 {
284 map { croak ((caller(0))[3] . ": invalid writer id" . ((defined($_))?": '$_'":'')) unless $writers_available->{$_}; } @{$writers};
285 map { push(@$channel_writers, $writers_available->{$_} ); } @{$writers};
286 }
287 # Or as space separated string
288 elsif ($writers)
289 {
290 map { croak ((caller(0))[3] . ": invalid writer id" . ((defined($_))?": '$_'":'')) unless $writers_available->{$_}; } split(/[,; ]+/, $writers);
291 map { push(@$channel_writers, $writers_available->{$_} ); } split(/[,; ]+/, $writers);
292 }
293
294 my $id;
295 my $channel = Log::Channel::Channel->new($channel_filters, $channel_writers, $dfr);
296
297 # If this method was called on behalf of some object, add the module within it`s channels
298 if (ref $invocant)
299 {
300 $id = ++$invocant->{SEQ};
301 $invocant->{CHANNELS}->{$id} = $channel;
302 push(@{$invocant->{CH_QUEUE}}, $id);
303 }
304 # Otherwise put it to the static class channel storage
305 else {
306 $id = ++$SEQ;
307 $CHANNELS->{$id} = $channel;
308 push(@$CH_QUEUE, $id);
309 }
310 return $id;
311}
312
313=item filter [PUBLIC, HYBRID]
314
315 Usage : Log::Loger->filter('filter1','threshold','WARNING','r'); or
316 $instance->filter('filter1','threshold','WARNING','r');
317 Purpose : Create new instance of the specific filter with given ID to be used in the channel() method
318 Returns : Nothing
319 Arguments : string $filter_id - identifier of the filter
320 string $filter_type - last name of the filter module
321 (... specific filter arguments - will be passed to the constructor)
322 Throws : Dies, if given invalid arguments
323 Comments :
324 See Also : channel() method
325
326=cut
327
328sub filter {
329 my $invocant = shift;
330 my ($filter_id, $filter_type, @arguments) = @_;
331 croak ((caller(0))[3] . ": invalid arguments") unless (defined($filter_id) and defined($filter_type));
332
333 # Attempt to create instance of writer module. No checking here on purpose
334 $filter_type = ucfirst($filter_type);
335 my $filter_module = "Log::Filter::$filter_type";
336 my $module = $filter_module->new(@arguments);
337 croak ((caller(0))[3] . ": invalid filter $filter_module") unless ($module->isa('Log::Filter::Module'));
338 if (ref $invocant)
339 {
340 $invocant->{FILTERS}->{$filter_id} = $module;
341 }
342 else {
343 $FILTERS->{$filter_id} = $module;
344 }
345}
346
347=item writer [PUBLIC, HYBRID]
348
349 Usage : Log::Loger->writer('writer1','std'); or
350 $instance->writer('writer1','std');
351 Purpose : Create new instance of the specific writer with given ID to be used in the channel() method
352 Returns : Nothing
353 Arguments : string $writer_id - identifier of the writer
354 string $writer_type - last name of the writer module
355 (... specific filter arguments - will be passed to the constructor)
356 Throws : Dies, if given invalid arguments
357 Comments :
358 See Also : channel() method
359
360=cut
361
362sub writer {
363 my $invocant = shift;
364 my ($writer_id, $writer_type, @arguments) = @_;
365 croak ((caller(0))[3] . ": invalid arguments") unless (defined($writer_id) and defined($writer_type));
366
367 # Attempt to create instance of writer module. No checking here on purpose
368 $writer_type = ucfirst($writer_type);
369 my $writer_module = "Log::Writer::$writer_type";
370 my $module = $writer_module->new(@arguments);
371 croak ((caller(0))[3] . ": invalid writer $writer_module") unless ($module->isa('Log::Writer::Module'));
372 if (ref $invocant)
373 {
374 $invocant->{WRITERS}->{$writer_id} = $module;
375 push(@{$invocant->{WRITER_TYPES}->{lc($writer_type)}}, $module);
376 }
377 else {
378 $WRITERS->{$writer_id} = $module;
379 push(@{$WRITER_TYPES->{lc($writer_type)}}, $module);
380 }
381}
382
383=item channel_count() [PUBLIC, HYBRID]
384
385 Usage : Log::Loger->channel_count(); or
386 $instance->channel_count();
387 Purpose : Get number of log channels created so far
388 Returns : integer - number of log channels created so far
389 Arguments : None
390 Throws : Nothing
391 Comments :
392 See Also :
393
394=cut
395
396sub channel_count()
397{
398 my $invocant = shift;
399 if (ref $invocant)
400 {
401 return scalar @{$invocant->{CH_QUEUE}};
402 }
403 else {
404 return scalar @$CH_QUEUE;
405 }
406}
407
408=item channel_remove($) [PUBLIC, HYBRID]
409
410 Usage : Log::Loger->channel_remove($id); or
411 $instance->channel_remove($id);
412 Purpose : Remove channel with given ID
413 Returns : Nothing
414 Arguments : integer $id - identifier of the channel to remove
415 Throws : Dies, if channel with given ID does not exist
416 Comments :
417 See Also :
418
419=cut
420
421sub channel_remove($)
422{
423 my $invocant = shift;
424 my $id = shift;
425 croak ((caller(0))[3] . ": ID of the channel to remove must be given as argument") unless $id;
426
427 my $channel_queue;
428 my $channels_current;
429 if (ref $invocant)
430 {
431 $channel_queue = $invocant->{CH_QUEUE};
432 $channels_current = $invocant->{CHANNELS};
433 }
434 else {
435 $channel_queue = $CH_QUEUE;
436 $channels_current = $CHANNELS;
437 }
438
439 croak ((caller(0))[3] . ": channel with ID '$id' does not exist") unless exists $channels_current->{$id};
440 delete $channels_current->{$id};
441
442 my @a = @$channel_queue;
443 my ($index, ) = grep { $a[$_] eq $id } 0..$#a;
444 splice(@a, $index, 1) if $index;
445 if (ref $invocant) { $invocant->{CH_QUEUE} = \@a; }
446 else { $CH_QUEUE = \@a; }
447}
448
449=item log [PUBLIC, HYBRID]
450
451 Usage : Log::Loger->log('source', 'ERROR', 'message');
452 $instance->log('source', 'ERROR', 'message');
453 Purpose : Write new log message to all defined channels
454 Returns : Nothing
455 Arguments : string $source - Name of the source of the message
456 enum $severity - Severity in integer or string format (see Log::Core::Essentials for permited values)
457 string $message - Message
458 enum $action - action to take after the message is written (exit|die|warn|croak)
459 Throws : Dies, if given invalid arguments
460 Comments :
461 See Also :
462
463=cut
464
465
# spent 97µs (44+53) within Log::Loger::log which was called 5 times, avg 19µs/call: # 3 times (24µs+26µs) by Log::Loger::debug at line 642, avg 17µs/call # 2 times (20µs+27µs) by Log::Loger::info at line 637, avg 24µs/call
sub log {
46652µs my $invocant = shift;
46754µs my ($source, $severity, $message, $action, $backtrace) = @_;
46852µs croak ((caller(0))[3] . ": invalid arguments") unless (defined($source) and defined($severity) and defined($message));
469
470 # Choose the output channels based on the invocant (class or object)
4715700ns my $channel_queue;
4725400ns my $channels_current;
47352µs if (ref $invocant)
474 {
475 $channel_queue = $invocant->{CH_QUEUE};
476 $channels_current = $invocant->{CHANNELS};
477 }
478 else {
47952µs $channel_queue = $CH_QUEUE;
48051µs $channels_current = $CHANNELS;
481 }
482
483 # Translate severity to string for printing purposes
484511µs553µs $severity = Log::Core::Essentials->severity_as_str($severity);
# spent 53µs making 5 calls to Log::Core::Essentials::severity_as_str, avg 11µs/call
485
486 # We must validate, that at least severity was correct
48751µs croak ((caller(0))[3] . ": invalid severity value") unless (defined($severity));
488
489 # Add backtrace to the message, if requested
4905900ns $message .= Carp::longmess() if $backtrace;
491
492 # Walk through all output channels
49355µs foreach my $chnl (@$channel_queue)
494 {
495 $channels_current->{$chnl}->write($source, $severity, $message);
496 }
497514µs if ($action)
498 {
499 if ($action eq 'exit') { exit 1; }
500 elsif ($action eq 'die') { die "$source $severity $message"; }
501 elsif ($action eq 'warn') { warn "$source $severity $message"; }
502 elsif ($action eq 'carp') { carp "$source $severity $message"; }
503 elsif ($action eq 'croak') { croak "$source $severity $message"; }
504 elsif ($action eq 'cluck') { cluck "$source $severity $message"; }
505 elsif ($action eq 'confess') { confess "$source $severity $message"; }
506 }
507}
508
509=item log_warn [PUBLIC, HYBRID]
510
511=item log_die [PUBLIC, HYBRID]
512
513=item log_exit [PUBLIC, HYBRID]
514
515=item log_carp [PUBLIC, HYBRID]
516
517=item log_croak [PUBLIC, HYBRID]
518
519=item log_cluck [PUBLIC, HYBRID]
520
521=item log_confess [PUBLIC, HYBRID]
522
523 Usage : Log::Loger->log_die('source', 'ERROR', 'message');
524 $instance->log_warn('source', 'ERROR', 'message');
525 Purpose : Shortcut to the log() method with specific action after writing the message
526 Returns : See log() method for details
527 Arguments : See log() method for details
528 Throws : See log() method for details
529 Comments : See log() method for details
530 See Also : See log() method for details
531
532=cut
533
534sub log_warn {
535 my $invocant = shift;
536 my ($source, $severity, $message, $backtrace) = @_;
537 $invocant->log($source, $severity, $message, 'warn', $backtrace);
538}
539
540sub log_die {
541 my $invocant = shift;
542 my ($source, $severity, $message, $backtrace) = @_;
543 $invocant->log($source, $severity, $message, 'die', $backtrace);
544}
545
546sub log_exit {
547 my $invocant = shift;
548 my ($source, $severity, $message, $backtrace) = @_;
549 $invocant->log($source, $severity, $message, 'exit', $backtrace);
550}
551
552sub log_carp {
553 my $invocant = shift;
554 my ($source, $severity, $message, $backtrace) = @_;
555 $invocant->log($source, $severity, $message, 'carp', $backtrace);
556}
557
558sub log_croak {
559 my $invocant = shift;
560 my ($source, $severity, $message, $backtrace) = @_;
561 $invocant->log($source, $severity, $message, 'croak', $backtrace);
562}
563
564sub log_cluck {
565 my $invocant = shift;
566 my ($source, $severity, $message, $backtrace) = @_;
567 $invocant->log($source, $severity, $message, 'cluck', $backtrace);
568}
569
570sub log_confess {
571 my $invocant = shift;
572 my ($source, $severity, $message, $backtrace) = @_;
573 $invocant->log($source, $severity, $message, 'confess', $backtrace);
574}
575
576=item emerg [PUBLIC,HYBRID]
577
578=item alert [PUBLIC,HYBRID]
579
580=item crit [PUBLIC,HYBRID]
581
582=item error [PUBLIC,HYBRID]
583
584=item warn [PUBLIC,HYBRID]
585
586=item notice [PUBLIC,HYBRID]
587
588=item info [PUBLIC,HYBRID]
589
590=item debug [PUBLIC,HYBRID]
591
592 Usage : Log::Loger->emerg('source', 'message');
593 $instance->alert('source', 'message');
594 Purpose : Shortcut to the log() method with specific severity of the message
595 Returns : See log() method for details
596 Arguments : See log() method for details
597 Throws : See log() method for details
598 Comments : See log() method for details
599 See Also : See log() method for details
600
601=cut
602
603# Shortcut functions for specified severities
604sub emerg {
605 my $invocant = shift;
606 my ($source, $message, $backtrace) = @_;
607 return $invocant->log($source, 'EMERG', $message, undef, $backtrace);
608}
609sub alert {
610 my $invocant = shift;
611 my ($source, $message, $backtrace) = @_;
612 return $invocant->log($source, 'ALERT', $message, undef, $backtrace);
613}
614sub crit {
615 my $invocant = shift;
616 my ($source, $message, $backtrace) = @_;
617 return $invocant->log($source, 'CRIT', $message, undef, $backtrace);
618}
619sub error {
620 my $invocant = shift;
621 my ($source, $message, $backtrace) = @_;
622 return $invocant->log($source, 'ERROR', $message, undef, $backtrace);
623}
624sub warn {
625 my $invocant = shift;
626 my ($source, $message, $backtrace) = @_;
627 return $invocant->log($source, 'WARNING', $message, undef, $backtrace);
628}
629sub notice {
630 my $invocant = shift;
631 my ($source, $message, $backtrace) = @_;
632 return $invocant->log($source, 'NOTICE', $message, undef, $backtrace);
633}
634
# spent 60µs (13+47) within Log::Loger::info which was called 2 times, avg 30µs/call: # once (6µs+25µs) by Mentat::Storage::Mongo::find_i at line 427 of Mentat/Storage/Mongo.pm # once (7µs+23µs) by Mentat::Storage::Mongo::find_i at line 392 of Mentat/Storage/Mongo.pm
sub info {
63521µs my $invocant = shift;
63622µs my ($source, $message, $backtrace) = @_;
63728µs247µs return $invocant->log($source, 'INFO', $message, undef, $backtrace);
# spent 47µs making 2 calls to Log::Loger::log, avg 24µs/call
638}
639
# spent 64µs (15+50) within Log::Loger::debug which was called 3 times, avg 21µs/call: # once (7µs+26µs) by Mentat::Storage::Mongo::find_i at line 413 of Mentat/Storage/Mongo.pm # once (4µs+13µs) by Mentat::Storage::Mongo::find_i at line 397 of Mentat/Storage/Mongo.pm # once (3µs+11µs) by Mentat::Storage::Mongo::find_i at line 418 of Mentat/Storage/Mongo.pm
sub debug {
64031µs my $invocant = shift;
64133µs my ($source, $message, $backtrace) = @_;
642312µs350µs return $invocant->log($source, 'DEBUG', $message, undef, $backtrace);
# spent 50µs making 3 calls to Log::Loger::log, avg 17µs/call
643}
644
645=item email [PUBLIC,HYBRID]
646
647 Usage : Log::Loger->email('source', 'message');
648 $instance->email('source', 'message');
649 Purpose : Send emails via all configured email writers
650 Returns : Nothing
651 Arguments : See log() method for details
652 Throws : Nothing
653
654=cut
655
656sub email {
657 my $invocant = shift;
658 my ($source, $message, $subject) = @_;
659
660 my $writer_queue;
661 if (ref $invocant) { $writer_queue = $invocant->{WRITER_TYPES}->{email}; }
662 else { $writer_queue = $WRITER_TYPES->{email}; }
663
664 # Walk through all email writers
665 if ($writer_queue) {
666 foreach my $writer (@$writer_queue) {
667 $writer->write($source, 'EMAIL', $message, $subject);
668 }
669 }
670}
671
672=pod
673
674=back
675
676=cut
677
67814µs1;