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

Filename/usr/local/lib/site_perl/Log/Writer/Module.pm
StatementsExecuted 16 statements in 828µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11115µs18µsLog::Writer::Module::::BEGIN@2Log::Writer::Module::BEGIN@2
1119µs32µsLog::Writer::Module::::BEGIN@62Log::Writer::Module::BEGIN@62
1118µs29µsLog::Writer::Module::::BEGIN@64Log::Writer::Module::BEGIN@64
1118µs43µsLog::Writer::Module::::BEGIN@61Log::Writer::Module::BEGIN@61
1118µs13µsLog::Writer::Module::::BEGIN@3Log::Writer::Module::BEGIN@3
1118µs35µsLog::Writer::Module::::BEGIN@73Log::Writer::Module::BEGIN@73
1114µs4µsLog::Writer::Module::::BEGIN@72Log::Writer::Module::BEGIN@72
1112µs2µsLog::Writer::Module::::ENDLog::Writer::Module::END
0000s0sLog::Writer::Module::::_backtraceLog::Writer::Module::_backtrace
0000s0sLog::Writer::Module::::_flagLog::Writer::Module::_flag
0000s0sLog::Writer::Module::::_get_possible_flagsLog::Writer::Module::_get_possible_flags
0000s0sLog::Writer::Module::::_initLog::Writer::Module::_init
0000s0sLog::Writer::Module::::_setup_flagsLog::Writer::Module::_setup_flags
0000s0sLog::Writer::Module::::_tracebackLog::Writer::Module::_traceback
0000s0sLog::Writer::Module::::handle_forkLog::Writer::Module::handle_fork
0000s0sLog::Writer::Module::::newLog::Writer::Module::new
0000s0sLog::Writer::Module::::writeLog::Writer::Module::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::Writer::Module;
2230µs221µs
# spent 18µs (15+3) within Log::Writer::Module::BEGIN@2 which was called: # once (15µs+3µs) by Log::Writer::Email::BEGIN@79 at line 2
use strict;
# spent 18µs making 1 call to Log::Writer::Module::BEGIN@2 # spent 3µs making 1 call to strict::import
3256µs219µs
# spent 13µs (8+5) within Log::Writer::Module::BEGIN@3 which was called: # once (8µs+5µs) by Log::Writer::Email::BEGIN@79 at line 3
use warnings;
# spent 13µs making 1 call to Log::Writer::Module::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::Writer::Module - Base module defining mandatory interface for all log writing modules
14
15=head1 SYNOPSIS
16
17 use Log::Writer::Module;
18
19 BEGIN {
20 @ISA = ('Log::Writer::Module');
21 }
22
23=head1 DESCRIPTION
24
25Classes extending this base class may be used as WRITERS in loging framework. Writers
26are used in log message channels for writing messages to various destinations.
27
28=head1 AUTHOR
29
30Jan Mach
31Cesnet, z.s.p.o
32jan.mach@cesnet.cz
33http://www.cesnet.cz
34
35=head1 COPYRIGHT
36
37This program is free software; you can redistribute
38it and/or modify it under the same terms as Perl itself.
39
40The full text of the license can be found in the
41LICENSE file included with this module.
42
43
44=head1 SEE ALSO
45
46perl(1).
47
48=head1 FUNCTION REFERENCE
49
50=over 4
51
52=cut
53
54#*******************************************************************************
55#
56# INITIALIZATION AND CLEANUP SECTION
57#
58#*******************************************************************************
59
60#-- Perl core modules ---------------------------------------------------------#
61229µs278µs
# spent 43µs (8+35) within Log::Writer::Module::BEGIN@61 which was called: # once (8µs+35µs) by Log::Writer::Email::BEGIN@79 at line 61
use Carp;
# spent 43µs making 1 call to Log::Writer::Module::BEGIN@61 # spent 35µs making 1 call to Exporter::import
62225µs255µs
# spent 32µs (9+23) within Log::Writer::Module::BEGIN@62 which was called: # once (9µs+23µs) by Log::Writer::Email::BEGIN@79 at line 62
use Scalar::Util 'blessed';
# spent 32µs making 1 call to Log::Writer::Module::BEGIN@62 # spent 23µs making 1 call to Exporter::import
63
64232µs250µs
# spent 29µs (8+21) within Log::Writer::Module::BEGIN@64 which was called: # once (8µs+21µs) by Log::Writer::Email::BEGIN@79 at line 64
use Data::Dumper; #-+-> DEVEL ONLY <-+-#
# spent 29µs making 1 call to Log::Writer::Module::BEGIN@64 # spent 21µs making 1 call to Exporter::import
65#use Smart::Comments; #-+-> DEVEL ONLY <-+-#
66
67#-- Perl CPAN modules ---------------------------------------------------------#
68
69#-- Custom application modules ------------------------------------------------#
70
71#-- Module initializations ----------------------------------------------------#
72
# spent 4µs within Log::Writer::Module::BEGIN@72 which was called: # once (4µs+0s) by Log::Writer::Email::BEGIN@79 at line 76
BEGIN {
73231µs263µs
# spent 35µs (8+28) within Log::Writer::Module::BEGIN@73 which was called: # once (8µs+28µs) by Log::Writer::Email::BEGIN@79 at line 73
use vars qw($VERSION $DEVEL);
# spent 35µs making 1 call to Log::Writer::Module::BEGIN@73 # spent 28µs making 1 call to vars::import
7424µs $VERSION = '0.01';
75 $DEVEL = 0;
761618µs14µs}
# spent 4µs making 1 call to Log::Writer::Module::BEGIN@72
77
78#-- Module clean-up code (global destructor) ----------------------------------#
7912µs
# spent 2µs within Log::Writer::Module::END which was called: # once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl
END {
80
81}
82
83#*******************************************************************************
84#
85# CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION
86#
87#*******************************************************************************
88
89#-- Constants -----------------------------------------------------------------#
90
91#-- Static public class variables (our) ---------------------------------------#
92
93#-- Static protected class variables (my) -------------------------------------#
94
95#*******************************************************************************
96#
97# IMPLEMENTATION SECTION
98#
99#*******************************************************************************
100
101=item new() [PUBLIC,STATIC]
102
103 Usage : my $filter = Log::Writer::(module)->new(... arguments);
104 Purpose : Create new instance of log writer
105 Arguments : All arguments are passed to the _init() method
106 Returns : Reference to the new instance
107 Throws : Croaks, if not invoked on class
108 Comments : This method should not be overloaded, descendants should implement their version of _init() method instead
109 See Also : _init() method
110
111=cut
112
113sub new
114{
115 my $class = shift;
116 croak ((caller(0))[3] . ": class method invoked on object") if blessed($class);
117 my $self = bless ({}, $class);
118 return $self->_init(@_);
119}
120
121=item write($$$) [ABSTRACT,PUBLIC]
122
123 Usage : $writer->write($source, $severity, $message);
124 Purpose : Write given message to the destination
125 Arguments : STRING $source - Name of the source of the message
126 ENUM $severity - Severity in integer or string format (see Log::Core::Essentials for permited values)
127 STRING $message - Log message
128 Returns : $self
129 Throws : Croaks, if not implemented in descendant classes
130 Comments : ABSTRACT method, must be implemented in descendant classes
131 See Also : Log::Core::Essentials module for permited severity values
132
133=cut
134
135sub write($$$)
136{
137 my $self = shift;
138 croak ((caller(0))[3] . ": method needs implementation");
139 # my ($source, $severity, $message) = @_;
140}
141
142=item handle_fork() [PUBLIC]
143
144 Usage : $writer->handle_fork();
145 Purpose : Allow writer to react to the fork() (sometimes it is necessary to reopen
146 file descriptors etc.)
147 Arguments : None
148 Returns : $self
149 Throws : Croaks, if not implemented in descendant classes
150 Comments : ABSTRACT method, must be implemented in descendant classes
151
152=cut
153
154sub handle_fork()
155{
156 my $self = shift;
157 croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self);
158 return $self;
159}
160
161#-------------------------------------------------------------------------------
162# Private interface
163#-------------------------------------------------------------------------------
164
165# _init [ABSTRACT,PROTECTED]
166#
167# Usage : return $self->_init(@_);
168# Purpose : Initialize the new Log::Writer::Module instance
169# Arguments : Unknown
170# Returns : Log::Writer::Module reference
171# Throws : Croaks, if not invoked on instance
172# Comments : This method must never be called directly, it is supposed to be overloaded by subclasses.
173
174sub _init
175{
176 my $self = shift;
177 croak ((caller(0))[3] . ": method needs implementation");
178}
179
180#-------------------------------------------------------------------------------
181
182# _get_possible_flags() [PROTECTED]
183#
184# Usage : my $flags = $self->_get_possible_flags();
185# Purpose : Get hash structure describing all possible flags
186# Arguments : None
187# Returns : HASH REFERENCE $flags
188# Throws : Croaks, if not invoked on instance
189
190sub _get_possible_flags()
191{
192 my $self = shift;
193 croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self);
194
195 return {};
196}
197
198# _setup_flags($) [PROTECTED]
199#
200# Usage :
201# Purpose :
202# Arguments :
203# Returns :
204# Throws : Croaks, if not invoked on instance
205
206sub _setup_flags($)
207{
208 my $self = shift;
209 croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self);
210 my ($flags,) = @_;
211
212 if ($flags) {
213 my $possible_flags = $self->_get_possible_flags();
214 foreach my $flag (split(/[,;]/, $flags)) {
215 if ($possible_flags->{$flag}) {
216 $self->{FLAGS}->{uc($possible_flags->{$flag})}++;
217 }
218 else {
219 croak ((caller(0))[3] . ": unknown flag '$flag'");
220 }
221 }
222 }
223 return $self;
224}
225
226# _flag($) [PROTECTED]
227#
228# Usage :
229# Purpose :
230# Arguments :
231# Returns :
232# Throws : Croaks, if not invoked on instance
233
234sub _flag($)
235{
236 my $self = shift;
237 croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self);
238 my ($flag,) = @_;
239
240 return $self->{FLAGS}->{uc($flag)};
241}
242
243# _traceback() [PROTECTED]
244#
245# Usage :
246# Purpose :
247# Arguments :
248# Returns :
249# Throws : Croaks, if not invoked on instance
250
251sub _traceback()
252{
253 my $self = shift;
254 croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self);
255
256 my @traceback = ();
257 my (@result, $tbline);
258 my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash);
259 my $i = 0;
260 while (@result = caller($i++))
261 {
262 ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = @result;
263 next if $package =~ /^Log::/;
264 $tbline = "Subroutine $subroutine called at [$package, $filename, L#$line]";
265 push(@traceback, $tbline);
266 }
267 return @traceback;
268}
269
270# _backtrace() [PROTECTED]
271#
272# Usage :
273# Purpose :
274# Arguments :
275# Returns :
276# Throws : Croaks, if not invoked on instance
277
278sub _backtrace()
279{
280 my $self = shift;
281 croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self);
282
283 my $backtrace = Carp::longmess();
284 my @lines = split(/\n/, $backtrace);
285 my @result = ();
286 foreach my $line (@lines) {
287 #next if $line =~ /^Log::/;
288 push(@result, $line);
289 }
290 return @result;
291}
292
293=pod
294
295=back
296
297=cut
298
29912µs1;