Filename | /usr/local/lib/site_perl/Log/Writer/Handle.pm |
Statements | Executed 35 statements in 1.36ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 554µs | 886µs | BEGIN@121 | Log::Writer::Handle::
1 | 1 | 1 | 11µs | 15µs | BEGIN@2 | Log::Writer::Handle::
1 | 1 | 1 | 9µs | 9µs | BEGIN@124 | Log::Writer::Handle::
1 | 1 | 1 | 8µs | 42µs | BEGIN@111 | Log::Writer::Handle::
1 | 1 | 1 | 8µs | 27µs | BEGIN@112 | Log::Writer::Handle::
1 | 1 | 1 | 8µs | 44µs | BEGIN@110 | Log::Writer::Handle::
1 | 1 | 1 | 7µs | 42µs | BEGIN@108 | Log::Writer::Handle::
1 | 1 | 1 | 7µs | 38µs | BEGIN@143 | Log::Writer::Handle::
1 | 1 | 1 | 7µs | 30µs | BEGIN@109 | Log::Writer::Handle::
1 | 1 | 1 | 7µs | 45µs | BEGIN@125 | Log::Writer::Handle::
1 | 1 | 1 | 6µs | 11µs | BEGIN@3 | Log::Writer::Handle::
1 | 1 | 1 | 6µs | 32µs | BEGIN@145 | Log::Writer::Handle::
1 | 1 | 1 | 6µs | 31µs | BEGIN@144 | Log::Writer::Handle::
1 | 1 | 1 | 6µs | 30µs | BEGIN@146 | Log::Writer::Handle::
1 | 1 | 1 | 6µs | 30µs | BEGIN@148 | Log::Writer::Handle::
1 | 1 | 1 | 4µs | 4µs | BEGIN@120 | Log::Writer::Handle::
1 | 1 | 1 | 2µs | 2µs | END | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | _format_message | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | _get_possible_flags | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | _init | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | _lock | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | _setup_date_format | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | _setup_handle | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | _unlock | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | handle_fork | Log::Writer::Handle::
0 | 0 | 0 | 0s | 0s | write | Log::Writer::Handle::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Log::Writer::Handle; | ||||
2 | 2 | 22µs | 2 | 18µs | # spent 15µs (11+3) within Log::Writer::Handle::BEGIN@2 which was called:
# once (11µs+3µs) by Log::Loger::BEGIN@130 at line 2 # spent 15µs making 1 call to Log::Writer::Handle::BEGIN@2
# spent 3µs making 1 call to strict::import |
3 | 2 | 71µs | 2 | 16µs | # spent 11µs (6+5) within Log::Writer::Handle::BEGIN@3 which was called:
# once (6µs+5µs) by Log::Loger::BEGIN@130 at line 3 # spent 11µs making 1 call to Log::Writer::Handle::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::Handle - Log writer capable of writing to any filehandle | ||||
14 | |||||
15 | =head1 SYNOPSIS | ||||
16 | |||||
17 | use Log::Writer::Handle; | ||||
18 | |||||
19 | # Prepare some IO capable objects (handles) | ||||
20 | my $buffer = ''; | ||||
21 | my $handle = IO::Handle->new_from_fd(fileno(STDERR),"w") or die "Can't open 'STDERR': $!\n"; | ||||
22 | my $handle = IO::File->new('./spool/writer-handle.log','>') or die "Can't open file './spool/test.log': $!\n"; | ||||
23 | my $handle = IO::String->new($buffer) or die "Can't open string buffer: $!\n"; | ||||
24 | |||||
25 | # Various methods of writer instantination | ||||
26 | my $writer = Log::Writer::Handle->new($handle); | ||||
27 | my $writer = Log::Writer::Handle->new($handle, 'iso8601'); | ||||
28 | my $writer = Log::Writer::Handle->new($handle, '%FT%T%z'); | ||||
29 | my $writer = Log::Writer::Handle->new($handle, undef, 'r'); | ||||
30 | my $writer = Log::Writer::Handle->new($handle, undef, 'rep'); | ||||
31 | my $writer = Log::Writer::Handle->new($handle, undef, 'replace'); | ||||
32 | my $writer = Log::Writer::Handle->new($handle, undef, 's', './spool/writer-handle.lock'); | ||||
33 | my $writer = Log::Writer::Handle->new($handle, undef, 'ser', './spool/writer-handle.lock'); | ||||
34 | my $writer = Log::Writer::Handle->new($handle, undef, 'serialize', './spool/writer-handle.lock'); | ||||
35 | my $writer = Log::Writer::Handle->new($handle, undef, 'r,s', './spool/writer-handle.lock'); | ||||
36 | my $writer = Log::Writer::Handle->new($handle, undef, 'rep,ser', './spool/writer-handle.lock'); | ||||
37 | my $writer = Log::Writer::Handle->new($handle, undef, 'replace,serialize', './spool/writer-handle.lock'); | ||||
38 | |||||
39 | # Write the message into the writer | ||||
40 | $writer->write('module', 'severity', 'Message from Log::Writer::Handle'); | ||||
41 | |||||
42 | # Process safe writing - if the fork occurs after log writer initialization, lock must be reopened | ||||
43 | my $writer = new Log::Writer::Handle($hnd, undef, 'rep ser', './spool/test.lock'); | ||||
44 | die "fork: $!" unless defined (my $pid = fork); | ||||
45 | $writer->handle_fork(); | ||||
46 | my $identity = '[CHILD] '; | ||||
47 | if ($pid) { $identity = '[PARENT]'; } | ||||
48 | $writer->write('module', 'severity', '$identity: Message from Log::Writer::Handle'); | ||||
49 | if ($pid) { wait; } | ||||
50 | |||||
51 | =head1 DESCRIPTION | ||||
52 | |||||
53 | This writer writes given messages to the given IO::Handle. | ||||
54 | |||||
55 | =head1 FLAGS | ||||
56 | |||||
57 | =over | ||||
58 | |||||
59 | =item B<c|com|comment> | ||||
60 | |||||
61 | COMMENT out every line with '#' character | ||||
62 | |||||
63 | =item B<r|rep|replace> | ||||
64 | |||||
65 | REPLACE source name given to the write() method with program name | ||||
66 | |||||
67 | =item B<s|ser|serialize> | ||||
68 | |||||
69 | SERIALIZE the write operations using mutual exclusion lock | ||||
70 | |||||
71 | =item B<t|tra|traceback> | ||||
72 | |||||
73 | TRACEBACK | ||||
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), Log::Core::Essentials(3). | ||||
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 | 25µs | 2 | 77µs | # spent 42µs (7+35) within Log::Writer::Handle::BEGIN@108 which was called:
# once (7µs+35µs) by Log::Loger::BEGIN@130 at line 108 # spent 42µs making 1 call to Log::Writer::Handle::BEGIN@108
# spent 35µs making 1 call to Exporter::import |
109 | 2 | 27µs | 2 | 53µs | # spent 30µs (7+23) within Log::Writer::Handle::BEGIN@109 which was called:
# once (7µs+23µs) by Log::Loger::BEGIN@130 at line 109 # spent 30µs making 1 call to Log::Writer::Handle::BEGIN@109
# spent 23µs making 1 call to Exporter::import |
110 | 2 | 25µs | 2 | 81µs | # spent 44µs (8+37) within Log::Writer::Handle::BEGIN@110 which was called:
# once (8µs+37µs) by Log::Loger::BEGIN@130 at line 110 # spent 44µs making 1 call to Log::Writer::Handle::BEGIN@110
# spent 37µs making 1 call to POSIX::import |
111 | 2 | 22µs | 2 | 75µs | # spent 42µs (8+33) within Log::Writer::Handle::BEGIN@111 which was called:
# once (8µs+33µs) by Log::Loger::BEGIN@130 at line 111 # spent 42µs making 1 call to Log::Writer::Handle::BEGIN@111
# spent 33µs making 1 call to Exporter::import |
112 | 2 | 33µs | 2 | 46µs | # spent 27µs (8+19) within Log::Writer::Handle::BEGIN@112 which was called:
# once (8µs+19µs) by Log::Loger::BEGIN@130 at line 112 # spent 27µs making 1 call to Log::Writer::Handle::BEGIN@112
# spent 19µs making 1 call to Exporter::import |
113 | |||||
114 | #use Data::Dumper; #-+-> DEVEL ONLY <-+-# | ||||
115 | #use Smart::Comments; #-+-> DEVEL ONLY <-+-# | ||||
116 | |||||
117 | #-- Perl CPAN modules ---------------------------------------------------------# | ||||
118 | |||||
119 | #-- Custom application modules ------------------------------------------------# | ||||
120 | 2 | 20µs | 1 | 4µs | # spent 4µs within Log::Writer::Handle::BEGIN@120 which was called:
# once (4µs+0s) by Log::Loger::BEGIN@130 at line 120 # spent 4µs making 1 call to Log::Writer::Handle::BEGIN@120 |
121 | 2 | 109µs | 1 | 886µs | # spent 886µs (554+332) within Log::Writer::Handle::BEGIN@121 which was called:
# once (554µs+332µs) by Log::Loger::BEGIN@130 at line 121 # spent 886µs making 1 call to Log::Writer::Handle::BEGIN@121 |
122 | |||||
123 | #-- Module initializations ----------------------------------------------------# | ||||
124 | # spent 9µs within Log::Writer::Handle::BEGIN@124 which was called:
# once (9µs+0s) by Log::Loger::BEGIN@130 at line 129 | ||||
125 | 2 | 39µs | 2 | 83µs | # spent 45µs (7+38) within Log::Writer::Handle::BEGIN@125 which was called:
# once (7µs+38µs) by Log::Loger::BEGIN@130 at line 125 # spent 45µs making 1 call to Log::Writer::Handle::BEGIN@125
# spent 38µs making 1 call to vars::import |
126 | 3 | 9µs | $VERSION = '0.01'; | ||
127 | $DEVEL = 0; | ||||
128 | @ISA = ('Log::Writer::Module'); | ||||
129 | 1 | 36µs | 1 | 9µs | } # spent 9µs making 1 call to Log::Writer::Handle::BEGIN@124 |
130 | |||||
131 | #-- Module clean-up code (global destructor) ----------------------------------# | ||||
132 | 1 | 2µs | # spent 2µs within Log::Writer::Handle::END which was called:
# once (2µs+0s) by main::RUNTIME at line 0 of mentat.storage.mongo.pl | ||
133 | |||||
134 | } | ||||
135 | |||||
136 | #******************************************************************************* | ||||
137 | # | ||||
138 | # CONSTANTS AND GLOBAL VARIABLES DEFINITION SECTION | ||||
139 | # | ||||
140 | #******************************************************************************* | ||||
141 | |||||
142 | #-- Constants -----------------------------------------------------------------# | ||||
143 | 2 | 26µs | 2 | 69µs | # spent 38µs (7+31) within Log::Writer::Handle::BEGIN@143 which was called:
# once (7µs+31µs) by Log::Loger::BEGIN@130 at line 143 # spent 38µs making 1 call to Log::Writer::Handle::BEGIN@143
# spent 31µs making 1 call to constant::import |
144 | 2 | 24µs | 2 | 57µs | # spent 31µs (6+26) within Log::Writer::Handle::BEGIN@144 which was called:
# once (6µs+26µs) by Log::Loger::BEGIN@130 at line 144 # spent 31µs making 1 call to Log::Writer::Handle::BEGIN@144
# spent 26µs making 1 call to constant::import |
145 | 2 | 23µs | 2 | 58µs | # spent 32µs (6+26) within Log::Writer::Handle::BEGIN@145 which was called:
# once (6µs+26µs) by Log::Loger::BEGIN@130 at line 145 # spent 32µs making 1 call to Log::Writer::Handle::BEGIN@145
# spent 26µs making 1 call to constant::import |
146 | 2 | 23µs | 2 | 55µs | # spent 30µs (6+25) within Log::Writer::Handle::BEGIN@146 which was called:
# once (6µs+25µs) by Log::Loger::BEGIN@130 at line 146 # spent 30µs making 1 call to Log::Writer::Handle::BEGIN@146
# spent 25µs making 1 call to constant::import |
147 | |||||
148 | 2 | 819µs | 2 | 53µs | # spent 30µs (6+24) within Log::Writer::Handle::BEGIN@148 which was called:
# once (6µs+24µs) by Log::Loger::BEGIN@130 at line 148 # spent 30µs making 1 call to Log::Writer::Handle::BEGIN@148
# spent 24µs making 1 call to constant::import |
149 | |||||
150 | #-- Static public class variables (our) ---------------------------------------# | ||||
151 | |||||
152 | #-- Static protected class variables (my) -------------------------------------# | ||||
153 | |||||
154 | #******************************************************************************* | ||||
155 | # | ||||
156 | # IMPLEMENTATION SECTION | ||||
157 | # | ||||
158 | #******************************************************************************* | ||||
159 | |||||
160 | =item write($$$) [PUBLIC] | ||||
161 | |||||
162 | Usage : $writer->write($source, $severity, $message); | ||||
163 | Purpose : Write given message to the destination | ||||
164 | Arguments : STRING $source - Name of the source of the message | ||||
165 | ENUM $severity - Severity in integer or string format (see Log::Core::Essentials for permited values) | ||||
166 | STRING $message - Log message | ||||
167 | Returns : $self | ||||
168 | Throws : Dies, if not implemented in descendant classes | ||||
169 | Comments : ABSTRACT method, must be implemented in descendant classes | ||||
170 | See Also : Log::Core::Essentials module for permited severity values | ||||
171 | |||||
172 | =cut | ||||
173 | |||||
174 | sub write($$$) | ||||
175 | { | ||||
176 | my $self = shift; | ||||
177 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
178 | my ($source, $severity, $message) = @_; | ||||
179 | croak ((caller(0))[3] . ": received invalid arguments") unless (defined($source) and defined($severity) and defined($message)); | ||||
180 | |||||
181 | # | ||||
182 | $self->_lock(); | ||||
183 | print { $self->{IO_HANDLE} } $self->_format_message($source, $severity, $message) or die ("Error writing message: $!"); | ||||
184 | $self->_unlock(); | ||||
185 | |||||
186 | return $self; | ||||
187 | } | ||||
188 | |||||
189 | =item handle_fork() [PUBLIC] | ||||
190 | |||||
191 | Usage : $writer->handle_fork(); | ||||
192 | Purpose : Allow writer to react to the fork() (sometimes it is necessary to reopen | ||||
193 | file descriptors etc.) | ||||
194 | Arguments : None | ||||
195 | Returns : $self | ||||
196 | Throws : Dies, if not implemented in descendant classes | ||||
197 | Comments : ABSTRACT method, must be implemented in descendant classes | ||||
198 | |||||
199 | =cut | ||||
200 | |||||
201 | sub handle_fork() | ||||
202 | { | ||||
203 | my $self = shift; | ||||
204 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
205 | |||||
206 | $self->{LOCK}->reopen(); | ||||
207 | return $self; | ||||
208 | } | ||||
209 | |||||
210 | #------------------------------------------------------------------------------- | ||||
211 | # Private interface | ||||
212 | #------------------------------------------------------------------------------- | ||||
213 | |||||
214 | # _init [PROTECTED] | ||||
215 | # | ||||
216 | # Usage : return $self->_init(@_); | ||||
217 | # Purpose : Initialize the new Log::Writer::Handle instance | ||||
218 | # Arguments : IO::Handle $handle - handle to write to | ||||
219 | # STRING $date_format - date format (see. man strftime(3) for details on syntax) [MANDATORY] | ||||
220 | # STRING $flags - various processing flags [OPTIONAL] | ||||
221 | # s | ser | serialize - serialize the writes (for multiprocess application) | ||||
222 | # r | rep | replace - replace source of the message with the program name | ||||
223 | # STRING $lock_file - name of the lock file [MANDATORY if 'serialize' flag is set] | ||||
224 | # Returns : Log::Writer::Module reference | ||||
225 | # Throws : Dies, if invoked on class | ||||
226 | # Comments : This method must never be called directly, it is supposed to be overloaded by subclasses | ||||
227 | |||||
228 | sub _init | ||||
229 | { | ||||
230 | my $self = shift; | ||||
231 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
232 | my ($handle, $date_format, $flags, $lock_file) = @_; | ||||
233 | croak ((caller(0))[3] . ": IO handle must be given as first argument") unless (defined($handle)); | ||||
234 | |||||
235 | $self->_setup_handle($handle); | ||||
236 | $self->_setup_date_format($date_format); | ||||
237 | $self->_setup_flags($flags); | ||||
238 | |||||
239 | if ($self->_flag(FLAG_SERIALIZE())) { | ||||
240 | croak ((caller(0))[3] . ": missing arguments - lock file") unless (defined($lock_file)); | ||||
241 | $self->{LOCK} = Mutex::Flock->new($lock_file); | ||||
242 | } | ||||
243 | return $self; | ||||
244 | } | ||||
245 | |||||
246 | # _get_possible_flags() [PROTECTED] | ||||
247 | # | ||||
248 | # Usage : my $flags = $self->_get_possible_flags(); | ||||
249 | # Purpose : Get hash structure describing all possible flags | ||||
250 | # Arguments : None | ||||
251 | # Returns : HASH REFERENCE $flags | ||||
252 | # Throws : Dies, if invoked on class | ||||
253 | |||||
254 | sub _get_possible_flags() | ||||
255 | { | ||||
256 | my $self = shift; | ||||
257 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
258 | |||||
259 | return { | ||||
260 | 'c' => FLAG_COMMENT(), | ||||
261 | 'com' => FLAG_COMMENT(), | ||||
262 | 'comment' => FLAG_COMMENT(), | ||||
263 | 'r' => FLAG_REPLACE(), | ||||
264 | 'rep' => FLAG_REPLACE(), | ||||
265 | 'replace' => FLAG_REPLACE(), | ||||
266 | 's' => FLAG_SERIALIZE(), | ||||
267 | 'ser' => FLAG_SERIALIZE(), | ||||
268 | 'serialize' => FLAG_SERIALIZE(), | ||||
269 | 't' => FLAG_TRACEBACK(), | ||||
270 | 'tra' => FLAG_TRACEBACK(), | ||||
271 | 'traceback' => FLAG_TRACEBACK(), | ||||
272 | }; | ||||
273 | } | ||||
274 | |||||
275 | # _setup_handle($) [PROTECTED] | ||||
276 | # | ||||
277 | # Usage : $self->_setup_handle($handle); | ||||
278 | # Purpose : Set IO::Handle to write messages to | ||||
279 | # Arguments : IO::Handle $handle - handle to write to | ||||
280 | # Returns : $self | ||||
281 | # Throws : Dies, if invoked on class, or if given invalid arguments | ||||
282 | |||||
283 | sub _setup_handle($) | ||||
284 | { | ||||
285 | my $self = shift; | ||||
286 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
287 | my ($handle,) = @_; | ||||
288 | croak ((caller(0))[3] . ": given handle is not capable of 'print'") unless ($handle->can("print")); | ||||
289 | |||||
290 | $self->{IO_HANDLE} = $handle; | ||||
291 | return $self; | ||||
292 | } | ||||
293 | |||||
294 | # _setup_date_format($) [PROTECTED] | ||||
295 | # | ||||
296 | # Usage : $self->_setup_date_format($date_format); | ||||
297 | # Purpose : Set format according to which to display the date | ||||
298 | # Arguments : STRING $date_format - date format (see. strftime() for details on syntax) | ||||
299 | # Returns : $self | ||||
300 | # Throws : Dies, if invoked on class | ||||
301 | |||||
302 | sub _setup_date_format($) | ||||
303 | { | ||||
304 | my $self = shift; | ||||
305 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
306 | my ($date_format,) = @_; | ||||
307 | |||||
308 | $self->{DATE_FORMAT} = $date_format; | ||||
309 | $self->{DATE_FORMAT} = '%FT%T%z' if $date_format and uc($date_format) eq ISO8601; | ||||
310 | return $self; | ||||
311 | } | ||||
312 | |||||
313 | # _format_message($$$) [PROTECTED] | ||||
314 | # | ||||
315 | # Usage : my $message = $self->_format_message($source, $severity, $message) | ||||
316 | # Purpose : Format log message from the given source, severity and message body | ||||
317 | # Arguments : STRING $source - Name of the source of the message | ||||
318 | # ENUM $severity - Severity in integer or string format (see Log::Core::Essentials for permited values) | ||||
319 | # STRING $message - Message | ||||
320 | # Returns : STRING formatted message | ||||
321 | # Throws : Dies, if invoked on class | ||||
322 | |||||
323 | sub _format_message($$$) | ||||
324 | { | ||||
325 | my $self = shift; | ||||
326 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
327 | my ($source, $severity, $message) = @_; | ||||
328 | |||||
329 | my $date = localtime; | ||||
330 | my $hostname = hostname; | ||||
331 | my $cmnt = ($self->_flag(FLAG_COMMENT()))?'# ':''; | ||||
332 | $source = basename($0) if ($self->_flag(FLAG_REPLACE())); | ||||
333 | $date = strftime($self->{DATE_FORMAT}, localtime) if ($self->{DATE_FORMAT}); | ||||
334 | $message =~ s/\n(.+)/\n# $1/g if ($self->_flag(FLAG_COMMENT())); | ||||
335 | |||||
336 | return "$cmnt$date $hostname ${source}[$$]: $severity: $message\n" unless $self->_flag(FLAG_TRACEBACK()); | ||||
337 | return "$cmnt$date $hostname ${source}[$$]: $severity: $message\n$cmnt Backtrace:\n$cmnt * " . join("\n$cmnt * ", $self->_traceback()) . "\n"; | ||||
338 | #return "$cmnt$date $hostname ${source}[$$]: $severity: $message\n$cmnt Backtrace:\n$cmnt * " . join("\n$cmnt * ", $self->_backtrace()) . "\n"; | ||||
339 | } | ||||
340 | |||||
341 | # _lock() [PROTECTED] | ||||
342 | # | ||||
343 | # Usage : $self->_lock(); | ||||
344 | # Purpose : Lock the lock file for serialization before writing | ||||
345 | # Arguments : None | ||||
346 | # Returns : $self | ||||
347 | # Throws : Dies, if invoked on class | ||||
348 | |||||
349 | sub _lock() { | ||||
350 | my $self = shift; | ||||
351 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
352 | |||||
353 | $self->{LOCK}->lock() if $self->_flag(FLAG_SERIALIZE()); | ||||
354 | return $self; | ||||
355 | } | ||||
356 | |||||
357 | # _unlock() [PROTECTED] | ||||
358 | # | ||||
359 | # Usage : $self->_unlock(); | ||||
360 | # Purpose : Unlock the lock file for serialization after writing | ||||
361 | # Arguments : None | ||||
362 | # Returns : $self | ||||
363 | # Throws : Dies, if invoked on class | ||||
364 | |||||
365 | sub _unlock() { | ||||
366 | my $self = shift; | ||||
367 | croak ((caller(0))[3] . ": instance method invoked on class") unless blessed($self); | ||||
368 | |||||
369 | $self->{LOCK}->unlock() if $self->_flag(FLAG_SERIALIZE()); | ||||
370 | return $self; | ||||
371 | } | ||||
372 | |||||
373 | =pod | ||||
374 | |||||
375 | =back | ||||
376 | |||||
377 | =cut | ||||
378 | |||||
379 | 1 | 2µs | 1; |