Filename | /usr/local/lib/site_perl/Log/Writer/Module.pm |
Statements | Executed 16 statements in 806µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 13µs | 16µs | BEGIN@2 | Log::Writer::Module::
1 | 1 | 1 | 8µs | 13µs | BEGIN@3 | Log::Writer::Module::
1 | 1 | 1 | 8µs | 43µs | BEGIN@61 | Log::Writer::Module::
1 | 1 | 1 | 8µs | 29µs | BEGIN@64 | Log::Writer::Module::
1 | 1 | 1 | 8µs | 32µs | BEGIN@62 | Log::Writer::Module::
1 | 1 | 1 | 8µs | 35µs | BEGIN@73 | Log::Writer::Module::
1 | 1 | 1 | 4µs | 4µs | BEGIN@72 | Log::Writer::Module::
1 | 1 | 1 | 2µs | 2µs | END | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | _backtrace | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | _flag | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | _get_possible_flags | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | _init | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | _setup_flags | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | _traceback | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | handle_fork | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | new | Log::Writer::Module::
0 | 0 | 0 | 0s | 0s | write | Log::Writer::Module::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Log::Writer::Module; | ||||
2 | 2 | 29µs | 2 | 20µs | # spent 16µs (13+3) within Log::Writer::Module::BEGIN@2 which was called:
# once (13µs+3µs) by Log::Writer::Email::BEGIN@79 at line 2 # spent 16µs making 1 call to Log::Writer::Module::BEGIN@2
# spent 3µs making 1 call to strict::import |
3 | 2 | 56µs | 2 | 18µ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 # 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 | |||||
13 | Log::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 | |||||
25 | Classes extending this base class may be used as WRITERS in loging framework. Writers | ||||
26 | are used in log message channels for writing messages to various destinations. | ||||
27 | |||||
28 | =head1 AUTHOR | ||||
29 | |||||
30 | Jan Mach | ||||
31 | Cesnet, z.s.p.o | ||||
32 | jan.mach@cesnet.cz | ||||
33 | http://www.cesnet.cz | ||||
34 | |||||
35 | =head1 COPYRIGHT | ||||
36 | |||||
37 | This program is free software; you can redistribute | ||||
38 | it and/or modify it under the same terms as Perl itself. | ||||
39 | |||||
40 | The full text of the license can be found in the | ||||
41 | LICENSE file included with this module. | ||||
42 | |||||
43 | |||||
44 | =head1 SEE ALSO | ||||
45 | |||||
46 | perl(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 ---------------------------------------------------------# | ||||
61 | 2 | 28µs | 2 | 78µ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 # spent 43µs making 1 call to Log::Writer::Module::BEGIN@61
# spent 35µs making 1 call to Exporter::import |
62 | 2 | 25µs | 2 | 55µs | # spent 32µs (8+24) within Log::Writer::Module::BEGIN@62 which was called:
# once (8µs+24µs) by Log::Writer::Email::BEGIN@79 at line 62 # spent 32µs making 1 call to Log::Writer::Module::BEGIN@62
# spent 24µs making 1 call to Exporter::import |
63 | |||||
64 | 2 | 32µs | 2 | 50µ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 # 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 | ||||
73 | 2 | 30µs | 2 | 63µ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 # spent 35µs making 1 call to Log::Writer::Module::BEGIN@73
# spent 28µs making 1 call to vars::import |
74 | 1 | 400ns | $VERSION = '0.01'; | ||
75 | 1 | 3µs | $DEVEL = 0; | ||
76 | 1 | 598µs | 1 | 4µs | } # spent 4µs making 1 call to Log::Writer::Module::BEGIN@72 |
77 | |||||
78 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
79 | 1 | 2µ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 | ||
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 | |||||
113 | sub 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 | |||||
135 | sub 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 | |||||
154 | sub 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 | |||||
174 | sub _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 | |||||
190 | sub _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 | |||||
206 | sub _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 | |||||
234 | sub _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 | |||||
251 | sub _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 | |||||
278 | sub _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 | |||||
299 | 1 | 2µs | 1; |