Filename | /usr/local/lib/site_perl/Log/Loger.pm |
Statements | Executed 129 statements in 3.77ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.33ms | 2.77ms | BEGIN@130 | Log::Loger::
1 | 1 | 1 | 1.05ms | 1.37ms | BEGIN@121 | Log::Loger::
1 | 1 | 1 | 1.02ms | 1.35ms | BEGIN@124 | Log::Loger::
1 | 1 | 1 | 1.01ms | 1.80ms | BEGIN@116 | Log::Loger::
1 | 1 | 1 | 966µs | 14.9ms | BEGIN@129 | Log::Loger::
1 | 1 | 1 | 912µs | 1.24ms | BEGIN@126 | Log::Loger::
1 | 1 | 1 | 900µs | 7.88ms | BEGIN@133 | Log::Loger::
1 | 1 | 1 | 746µs | 1.46ms | BEGIN@136 | Log::Loger::
1 | 1 | 1 | 483µs | 787µs | BEGIN@131 | Log::Loger::
1 | 1 | 1 | 396µs | 553µs | BEGIN@132 | Log::Loger::
1 | 1 | 1 | 387µs | 1.29ms | BEGIN@119 | Log::Loger::
1 | 1 | 1 | 380µs | 501µs | BEGIN@120 | Log::Loger::
1 | 1 | 1 | 343µs | 460µs | BEGIN@123 | Log::Loger::
1 | 1 | 1 | 333µs | 490µs | BEGIN@125 | Log::Loger::
1 | 1 | 1 | 320µs | 443µs | BEGIN@122 | Log::Loger::
5 | 2 | 1 | 45µs | 100µs | log | Log::Loger::
2 | 2 | 1 | 16µs | 66µs | info | Log::Loger::
1 | 1 | 1 | 15µs | 22µs | BEGIN@2 | Log::Loger::
3 | 3 | 1 | 15µs | 64µs | debug | Log::Loger::
1 | 1 | 1 | 11µs | 40µs | BEGIN@109 | Log::Loger::
1 | 1 | 1 | 7µs | 55µs | BEGIN@108 | Log::Loger::
1 | 1 | 1 | 7µs | 27µs | BEGIN@140 | Log::Loger::
1 | 1 | 1 | 7µs | 12µs | BEGIN@3 | Log::Loger::
1 | 1 | 1 | 3µs | 3µs | BEGIN@139 | Log::Loger::
1 | 1 | 1 | 2µs | 2µs | END | Log::Loger::
0 | 0 | 0 | 0s | 0s | alert | Log::Loger::
0 | 0 | 0 | 0s | 0s | channel | Log::Loger::
0 | 0 | 0 | 0s | 0s | channel_count | Log::Loger::
0 | 0 | 0 | 0s | 0s | channel_remove | Log::Loger::
0 | 0 | 0 | 0s | 0s | crit | Log::Loger::
0 | 0 | 0 | 0s | 0s | |
0 | 0 | 0 | 0s | 0s | emerg | Log::Loger::
0 | 0 | 0 | 0s | 0s | error | Log::Loger::
0 | 0 | 0 | 0s | 0s | filter | Log::Loger::
0 | 0 | 0 | 0s | 0s | get_debug | Log::Loger::
0 | 0 | 0 | 0s | 0s | log_carp | Log::Loger::
0 | 0 | 0 | 0s | 0s | log_cluck | Log::Loger::
0 | 0 | 0 | 0s | 0s | log_confess | Log::Loger::
0 | 0 | 0 | 0s | 0s | log_croak | Log::Loger::
0 | 0 | 0 | 0s | 0s | log_die | Log::Loger::
0 | 0 | 0 | 0s | 0s | log_exit | Log::Loger::
0 | 0 | 0 | 0s | 0s | log_warn | Log::Loger::
0 | 0 | 0 | 0s | 0s | new | Log::Loger::
0 | 0 | 0 | 0s | 0s | notice | Log::Loger::
0 | 0 | 0 | 0s | 0s | on | Log::Loger::
0 | 0 | 0 | 0s | 0s | warn | Log::Loger::
0 | 0 | 0 | 0s | 0s | writer | Log::Loger::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Log::Loger; | ||||
2 | 2 | 22µs | 2 | 28µs | # spent 22µs (15+6) within Log::Loger::BEGIN@2 which was called:
# once (15µs+6µs) by Mentat::Storage::Mongo::BEGIN@170 at line 2 # spent 22µs making 1 call to Log::Loger::BEGIN@2
# spent 6µs making 1 call to strict::import |
3 | 2 | 73µs | 2 | 17µs | # spent 12µs (7+5) within Log::Loger::BEGIN@3 which was called:
# once (7µs+5µs) by Mentat::Storage::Mongo::BEGIN@170 at line 3 # spent 12µ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 | |||||
13 | Log::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 | |||||
54 | This log framework is designed to be easy to use and extend to your needs. | ||||
55 | It may be used through static or instance methods. The design was inspired | ||||
56 | by syslog-ng loger. | ||||
57 | |||||
58 | All incoming messages are directed to the CHANNELS. CHANNELS are composed | ||||
59 | of one or more chained FILTERS and one or more WRITERS. When message | ||||
60 | enters the CHANNEL, all FILTERS are consulted in order to determine, if the | ||||
61 | message will be passed to the WRITERS to be written to the destinations. | ||||
62 | |||||
63 | By default, FILTERS work in the SUFFICIENT mode - their result is authoritative | ||||
64 | and if the message passes particular filter, result is sufficient and no | ||||
65 | other filters are considered. If the message is rejected, default channel | ||||
66 | policy aplies. This default behaviour may be altered using the 'r' flag | ||||
67 | passed to most of the filters. In the REQUIRED mode, if the message is rejected, | ||||
68 | result is authoritative and no more filters are considered. If the message | ||||
69 | passes, next filter in row is considered. | ||||
70 | |||||
71 | Most of the filters also accept the 'i' flag, which inverts the result. It means, | ||||
72 | that the filter will return REJECT instead of ACCEPT and vice versa. Please | ||||
73 | see 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 | |||||
84 | This program is free software; you can redistribute | ||||
85 | it and/or modify it under the same terms as Perl itself. | ||||
86 | |||||
87 | The full text of the license can be found in the | ||||
88 | LICENSE file included with this module. | ||||
89 | |||||
90 | |||||
91 | =head1 SEE ALSO | ||||
92 | |||||
93 | perl(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 ---------------------------------------------------------# | ||||
108 | 2 | 24µs | 2 | 103µs | # spent 55µs (7+48) within Log::Loger::BEGIN@108 which was called:
# once (7µs+48µs) by Mentat::Storage::Mongo::BEGIN@170 at line 108 # spent 55µs making 1 call to Log::Loger::BEGIN@108
# spent 48µs making 1 call to Exporter::import |
109 | 2 | 29µs | 2 | 69µs | # spent 40µs (11+29) within Log::Loger::BEGIN@109 which was called:
# once (11µs+29µs) by Mentat::Storage::Mongo::BEGIN@170 at line 109 # spent 40µs making 1 call to Log::Loger::BEGIN@109
# spent 29µs making 1 call to Exporter::import |
110 | |||||
111 | #-- Perl CPAN modules ---------------------------------------------------------# | ||||
112 | |||||
113 | #-- Custom application modules ------------------------------------------------# | ||||
114 | |||||
115 | # Core logging contants and utilities | ||||
116 | 2 | 123µs | 1 | 1.80ms | # spent 1.80ms (1.01+794µs) within Log::Loger::BEGIN@116 which was called:
# once (1.01ms+794µs) by Mentat::Storage::Mongo::BEGIN@170 at line 116 # spent 1.80ms making 1 call to Log::Loger::BEGIN@116 |
117 | |||||
118 | # Log filtering modules | ||||
119 | 2 | 121µs | 1 | 1.29ms | # spent 1.29ms (387µs+902µs) within Log::Loger::BEGIN@119 which was called:
# once (387µs+902µs) by Mentat::Storage::Mongo::BEGIN@170 at line 119 # spent 1.29ms making 1 call to Log::Loger::BEGIN@119 |
120 | 2 | 107µs | 1 | 501µs | # spent 501µs (380+120) within Log::Loger::BEGIN@120 which was called:
# once (380µs+120µs) by Mentat::Storage::Mongo::BEGIN@170 at line 120 # spent 501µs making 1 call to Log::Loger::BEGIN@120 |
121 | 2 | 110µs | 1 | 1.37ms | # spent 1.37ms (1.05+317µs) within Log::Loger::BEGIN@121 which was called:
# once (1.05ms+317µs) by Mentat::Storage::Mongo::BEGIN@170 at line 121 # spent 1.37ms making 1 call to Log::Loger::BEGIN@121 |
122 | 2 | 118µs | 1 | 443µs | # spent 443µs (320+123) within Log::Loger::BEGIN@122 which was called:
# once (320µs+123µs) by Mentat::Storage::Mongo::BEGIN@170 at line 122 # spent 443µs making 1 call to Log::Loger::BEGIN@122 |
123 | 2 | 105µs | 1 | 460µs | # spent 460µs (343+118) within Log::Loger::BEGIN@123 which was called:
# once (343µs+118µs) by Mentat::Storage::Mongo::BEGIN@170 at line 123 # spent 460µs making 1 call to Log::Loger::BEGIN@123 |
124 | 2 | 139µs | 1 | 1.35ms | # spent 1.35ms (1.02+331µs) within Log::Loger::BEGIN@124 which was called:
# once (1.02ms+331µs) by Mentat::Storage::Mongo::BEGIN@170 at line 124 # spent 1.35ms making 1 call to Log::Loger::BEGIN@124 |
125 | 2 | 110µs | 1 | 490µs | # spent 490µs (333+158) within Log::Loger::BEGIN@125 which was called:
# once (333µs+158µs) by Mentat::Storage::Mongo::BEGIN@170 at line 125 # spent 490µs making 1 call to Log::Loger::BEGIN@125 |
126 | 2 | 123µs | 1 | 1.24ms | # spent 1.24ms (912µs+326µs) within Log::Loger::BEGIN@126 which was called:
# once (912µs+326µs) by Mentat::Storage::Mongo::BEGIN@170 at line 126 # spent 1.24ms making 1 call to Log::Loger::BEGIN@126 |
127 | |||||
128 | # Log writing modules | ||||
129 | 2 | 110µs | 1 | 14.9ms | # spent 14.9ms (966µs+14.0) within Log::Loger::BEGIN@129 which was called:
# once (966µs+14.0ms) by Mentat::Storage::Mongo::BEGIN@170 at line 129 # spent 14.9ms making 1 call to Log::Loger::BEGIN@129 |
130 | 2 | 116µs | 1 | 2.77ms | # spent 2.77ms (1.33+1.44) within Log::Loger::BEGIN@130 which was called:
# once (1.33ms+1.44ms) by Mentat::Storage::Mongo::BEGIN@170 at line 130 # spent 2.77ms making 1 call to Log::Loger::BEGIN@130 |
131 | 2 | 109µs | 1 | 787µs | # spent 787µs (483+305) within Log::Loger::BEGIN@131 which was called:
# once (483µs+305µs) by Mentat::Storage::Mongo::BEGIN@170 at line 131 # spent 787µs making 1 call to Log::Loger::BEGIN@131 |
132 | 2 | 107µs | 1 | 553µs | # spent 553µs (396+157) within Log::Loger::BEGIN@132 which was called:
# once (396µs+157µs) by Mentat::Storage::Mongo::BEGIN@170 at line 132 # spent 553µs making 1 call to Log::Loger::BEGIN@132 |
133 | 2 | 111µs | 1 | 7.88ms | # spent 7.88ms (900µs+6.98) within Log::Loger::BEGIN@133 which was called:
# once (900µs+6.98ms) by Mentat::Storage::Mongo::BEGIN@170 at line 133 # spent 7.88ms making 1 call to Log::Loger::BEGIN@133 |
134 | |||||
135 | # Log channel modules | ||||
136 | 2 | 126µs | 1 | 1.46ms | # spent 1.46ms (746µs+717µs) within Log::Loger::BEGIN@136 which was called:
# once (746µs+717µs) by Mentat::Storage::Mongo::BEGIN@170 at line 136 # spent 1.46ms 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 | ||||
140 | 2 | 24µs | 2 | 46µs | # spent 27µ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 # spent 27µs making 1 call to Log::Loger::BEGIN@140
# spent 20µs making 1 call to vars::import |
141 | 1 | 4µs | $VERSION = '0.01'; | ||
142 | 1 | 1.77ms | 1 | 3µs | } # spent 3µs making 1 call to Log::Loger::BEGIN@139 |
143 | |||||
144 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
145 | 1 | 2µ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 | ||
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 | ||||
162 | 1 | 1µs | my $WRITERS = {}; | ||
163 | 1 | 200ns | my $WRITER_TYPES = {}; | ||
164 | 1 | 300ns | my $FILTERS = {}; | ||
165 | 1 | 200ns | my $CHANNELS = {}; | ||
166 | 1 | 300ns | my $CH_QUEUE = []; | ||
167 | |||||
168 | # Sequential indentifiers | ||||
169 | 1 | 300ns | my $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 | |||||
189 | sub 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 | |||||
216 | sub 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 | |||||
236 | sub 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 | |||||
256 | sub 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 | |||||
328 | sub 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 | |||||
362 | sub 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 | |||||
396 | sub 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 | |||||
421 | sub 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 | sub log { | ||||
466 | 55 | 43µs | my $invocant = shift; | ||
467 | my ($source, $severity, $message, $action, $backtrace) = @_; | ||||
468 | 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) | ||||
471 | my $channel_queue; | ||||
472 | my $channels_current; | ||||
473 | 10 | 3µs | if (ref $invocant) | ||
474 | { | ||||
475 | $channel_queue = $invocant->{CH_QUEUE}; | ||||
476 | $channels_current = $invocant->{CHANNELS}; | ||||
477 | } | ||||
478 | else { | ||||
479 | $channel_queue = $CH_QUEUE; | ||||
480 | $channels_current = $CHANNELS; | ||||
481 | } | ||||
482 | |||||
483 | # Translate severity to string for printing purposes | ||||
484 | 5 | 55µs | $severity = Log::Core::Essentials->severity_as_str($severity); # spent 55µ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 | ||||
487 | croak ((caller(0))[3] . ": invalid severity value") unless (defined($severity)); | ||||
488 | |||||
489 | # Add backtrace to the message, if requested | ||||
490 | $message .= Carp::longmess() if $backtrace; | ||||
491 | |||||
492 | # Walk through all output channels | ||||
493 | foreach my $chnl (@$channel_queue) | ||||
494 | { | ||||
495 | $channels_current->{$chnl}->write($source, $severity, $message); | ||||
496 | } | ||||
497 | 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 | |||||
534 | sub log_warn { | ||||
535 | my $invocant = shift; | ||||
536 | my ($source, $severity, $message, $backtrace) = @_; | ||||
537 | $invocant->log($source, $severity, $message, 'warn', $backtrace); | ||||
538 | } | ||||
539 | |||||
540 | sub log_die { | ||||
541 | my $invocant = shift; | ||||
542 | my ($source, $severity, $message, $backtrace) = @_; | ||||
543 | $invocant->log($source, $severity, $message, 'die', $backtrace); | ||||
544 | } | ||||
545 | |||||
546 | sub log_exit { | ||||
547 | my $invocant = shift; | ||||
548 | my ($source, $severity, $message, $backtrace) = @_; | ||||
549 | $invocant->log($source, $severity, $message, 'exit', $backtrace); | ||||
550 | } | ||||
551 | |||||
552 | sub log_carp { | ||||
553 | my $invocant = shift; | ||||
554 | my ($source, $severity, $message, $backtrace) = @_; | ||||
555 | $invocant->log($source, $severity, $message, 'carp', $backtrace); | ||||
556 | } | ||||
557 | |||||
558 | sub log_croak { | ||||
559 | my $invocant = shift; | ||||
560 | my ($source, $severity, $message, $backtrace) = @_; | ||||
561 | $invocant->log($source, $severity, $message, 'croak', $backtrace); | ||||
562 | } | ||||
563 | |||||
564 | sub log_cluck { | ||||
565 | my $invocant = shift; | ||||
566 | my ($source, $severity, $message, $backtrace) = @_; | ||||
567 | $invocant->log($source, $severity, $message, 'cluck', $backtrace); | ||||
568 | } | ||||
569 | |||||
570 | sub 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 | ||||
604 | sub emerg { | ||||
605 | my $invocant = shift; | ||||
606 | my ($source, $message, $backtrace) = @_; | ||||
607 | return $invocant->log($source, 'EMERG', $message, undef, $backtrace); | ||||
608 | } | ||||
609 | sub alert { | ||||
610 | my $invocant = shift; | ||||
611 | my ($source, $message, $backtrace) = @_; | ||||
612 | return $invocant->log($source, 'ALERT', $message, undef, $backtrace); | ||||
613 | } | ||||
614 | sub crit { | ||||
615 | my $invocant = shift; | ||||
616 | my ($source, $message, $backtrace) = @_; | ||||
617 | return $invocant->log($source, 'CRIT', $message, undef, $backtrace); | ||||
618 | } | ||||
619 | sub error { | ||||
620 | my $invocant = shift; | ||||
621 | my ($source, $message, $backtrace) = @_; | ||||
622 | return $invocant->log($source, 'ERROR', $message, undef, $backtrace); | ||||
623 | } | ||||
624 | sub warn { | ||||
625 | my $invocant = shift; | ||||
626 | my ($source, $message, $backtrace) = @_; | ||||
627 | return $invocant->log($source, 'WARNING', $message, undef, $backtrace); | ||||
628 | } | ||||
629 | sub notice { | ||||
630 | my $invocant = shift; | ||||
631 | my ($source, $message, $backtrace) = @_; | ||||
632 | return $invocant->log($source, 'NOTICE', $message, undef, $backtrace); | ||||
633 | } | ||||
634 | # spent 66µs (16+51) within Log::Loger::info which was called 2 times, avg 33µs/call:
# once (9µs+25µs) by Mentat::Storage::Mongo::find_i at line 392 of Mentat/Storage/Mongo.pm
# once (7µs+26µs) by Mentat::Storage::Mongo::find_i at line 427 of Mentat/Storage/Mongo.pm | ||||
635 | 6 | 16µs | my $invocant = shift; | ||
636 | my ($source, $message, $backtrace) = @_; | ||||
637 | 2 | 51µs | return $invocant->log($source, 'INFO', $message, undef, $backtrace); # spent 51µs making 2 calls to Log::Loger::log, avg 25µs/call | ||
638 | } | ||||
639 | # spent 64µs (15+49) 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 (5µs+13µs) by Mentat::Storage::Mongo::find_i at line 397 of Mentat/Storage/Mongo.pm
# once (3µs+10µs) by Mentat::Storage::Mongo::find_i at line 422 of Mentat/Storage/Mongo.pm | ||||
640 | 9 | 17µs | my $invocant = shift; | ||
641 | my ($source, $message, $backtrace) = @_; | ||||
642 | 3 | 49µs | return $invocant->log($source, 'DEBUG', $message, undef, $backtrace); # spent 49µs making 3 calls to Log::Loger::log, avg 16µ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 | |||||
656 | sub 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 | |||||
678 | 1 | 4µs | 1; |