File Coverage

blib/lib/Log/Handler/Output/File.pm
Criterion Covered Total %
statement 77 114 67.5
branch 27 86 31.4
condition 0 3 0.0
subroutine 15 20 75.0
pod 7 7 100.0
total 126 230 54.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Log::Handler::Output::File - Log messages to a file.
4              
5             =head1 SYNOPSIS
6              
7             use Log::Handler::Output::File;
8              
9             my $log = Log::Handler::Output::File->new(
10             filename => "file.log",
11             filelock => 1,
12             fileopen => 1,
13             reopen => 1,
14             mode => "append",
15             autoflush => 1,
16             permissions => "0664",
17             utf8 => 0,
18             );
19              
20             $log->log(message => $message);
21              
22             =head1 DESCRIPTION
23              
24             Log messages to a file.
25              
26             =head1 METHODS
27              
28             =head2 new()
29              
30             Call C to create a new Log::Handler::Output::File object.
31              
32             The following options are possible:
33              
34             =over 4
35              
36             =item B
37              
38             With C you can set a file name as a string or as a array reference.
39             If you set a array reference then the parts will be concat with C from
40             C.
41              
42             Set a file name:
43              
44             my $log = Log::Handler::Output::File->new( filename => "file.log" );
45              
46             Set a array reference:
47              
48             my $log = Log::Handler::Output::File->new(
49              
50             # foo/bar/baz.log
51             filename => [ "foo", "bar", "baz.log" ],
52              
53             # /foo/bar/baz.log
54             filename => [ "", "foo", "bar", "baz.log" ],
55              
56             );
57              
58             =item B
59              
60             Maybe it's desirable to lock the log file by each write operation because a lot
61             of processes write at the same time to the log file. You can set the option
62             C to 0 or 1.
63              
64             0 - no file lock
65             1 - exclusive lock (LOCK_EX) and unlock (LOCK_UN) by each write operation (default)
66              
67             =item B
68              
69             Open a log file transient or permanent.
70              
71             0 - open and close the logfile by each write operation
72             1 - open the logfile if C called and try to reopen the
73             file if C is set to 1 and the inode of the file has changed (default)
74              
75             =item B
76              
77             This option works only if option C is set to 1.
78              
79             0 - deactivated
80             1 - try to reopen the log file if the inode changed (default)
81              
82             =item How to use B and B
83              
84             Please note that it's better to set C and C to 0 on Windows
85             because Windows unfortunately haven't the faintest idea of inodes.
86              
87             To write your code independent you should control it:
88              
89             my $os_is_win = $^O =~ /win/i ? 0 : 1;
90              
91             my $log = Log::Handler::Output::File->new(
92             filename => "file.log",
93             mode => "append",
94             fileopen => $os_is_win
95             );
96              
97             If you set C to 0 then it implies that C has no importance.
98              
99             =item B
100              
101             There are three possible modes to open a log file.
102              
103             append - O_WRONLY | O_APPEND | O_CREAT (default)
104             excl - O_WRONLY | O_EXCL | O_CREAT
105             trunc - O_WRONLY | O_TRUNC | O_CREAT
106              
107             C would open the log file in any case and appends the messages at
108             the end of the log file.
109              
110             C would fail by open the log file if the log file already exists.
111              
112             C would truncate the complete log file if it exists. Please take care
113             to use this option.
114              
115             Take a look to the documentation of C to get more information.
116              
117             =item B
118              
119             0 - autoflush off
120             1 - autoflush on (default)
121              
122             =item B
123              
124             The option C sets the permission of the file if it creates and
125             must be set as a octal value. The permission need to be in octal and are
126             modified by your process's current "umask".
127              
128             That means that you have to use the unix style permissions such as C.
129             C<0640> is the default permission for this option. That means that the owner
130             got read and write permissions and users in the same group got only read
131             permissions. All other users got no access.
132              
133             Take a look to the documentation of C to get more information.
134              
135             =item B, B
136              
137             utf8 = binmode, $fh, ":utf8";
138             utf-8 = binmode, $fh, "encoding(utf-8)";
139              
140             Yes, there is a difference.
141              
142             L
143              
144             L
145              
146             =item B
147              
148             It's possible to set a pattern in the filename that is replaced with a date.
149             If the date - and the filename - changed the file is closed and reopened with
150             the new filename. The filename is converted with C.
151              
152             Example:
153              
154             my $log = Log::Handler::Output::File->new(
155             filename => "file-%Y-%m-%d.log",
156             dateext => 1
157             );
158              
159             In this example the file C is created. At the next day the filename
160             changed, the log file C is closed and C is opened.
161              
162             This feature is a small improvement for systems where no logrotate is available like Windows
163             systems. On this way you have the chance to delete old log files without to stop/start a
164             daemon.
165              
166             =back
167              
168             =head2 log()
169              
170             Call C if you want to log messages to the log file.
171              
172             Example:
173              
174             $log->log(message => "this message goes to the logfile");
175              
176             =head2 flush()
177              
178             Call C if you want to re-open the log file.
179              
180             This is useful if you don't want to use option S<"reopen">. As example
181             if a rotate mechanism moves the logfile and you want to re-open a new
182             one.
183              
184             =head2 validate()
185              
186             Validate a configuration.
187              
188             =head2 reload()
189              
190             Reload with a new configuration.
191              
192             =head2 errstr()
193              
194             Call C to get the last error message.
195              
196             =head2 close()
197              
198             Call C to close the log file yourself - normally you don't need
199             to use it, because the log file will be opened and closed automatically.
200              
201             =head1 PREREQUISITES
202              
203             Carp
204             Fcntl
205             File::Spec
206             Params::Validate
207              
208             =head1 EXPORTS
209              
210             No exports.
211              
212             =head1 REPORT BUGS
213              
214             Please report all bugs to .
215              
216             If you send me a mail then add Log::Handler into the subject.
217              
218             =head1 AUTHOR
219              
220             Jonny Schulz .
221              
222             =head1 COPYRIGHT
223              
224             Copyright (C) 2007-2009 by Jonny Schulz. All rights reserved.
225              
226             This program is free software; you can redistribute it and/or
227             modify it under the same terms as Perl itself.
228              
229             =cut
230              
231             package Log::Handler::Output::File;
232              
233 3     3   72275 use strict;
  3         16  
  3         91  
234 3     3   14 use warnings;
  3         5  
  3         95  
235 3     3   16 use Carp;
  3         6  
  3         199  
236 3     3   19 use Fcntl qw( :flock O_WRONLY O_APPEND O_TRUNC O_EXCL O_CREAT );
  3         6  
  3         514  
237 3     3   21 use File::Spec;
  3         7  
  3         57  
238 3     3   644 use Params::Validate qw();
  3         9533  
  3         61  
239 3     3   521 use POSIX;
  3         6588  
  3         34  
240              
241             our $VERSION = "0.08";
242             our $ERRSTR = "";
243              
244             sub new {
245 3     3 1 167 my $class = shift;
246 3         11 my $opts = $class->_validate(@_);
247 3         22 my $self = bless $opts, $class;
248              
249             # open the log file permanent
250 3 50       27 if ($self->{dateext}) {
    50          
251 0 0       0 $self->_check_dateext
252             or return undef;
253             } elsif ($self->{fileopen}) {
254 0 0       0 $self->_open
255             or croak $self->errstr;
256             }
257              
258 3         12 return $self;
259             }
260              
261             sub log {
262 1     1 1 7 my $self = shift;
263 1 50       5 my $message = @_ > 1 ? {@_} : shift;
264              
265 1 50       5 if ($self->{dateext}) {
266 0 0       0 $self->_check_dateext or return undef;
267             }
268              
269 1 50       4 if (!$self->{fileopen}) {
    0          
270 1 50       4 $self->_open or return undef;
271             } elsif ($self->{reopen}) {
272 0 0       0 $self->_checkino or return undef;
273             }
274              
275 1 50       4 if ($self->{filelock}) {
276 0 0       0 flock($self->{fh}, LOCK_EX)
277             or return $self->_raise_error("unable to lock logfile $self->{filename}: $!");
278             }
279              
280 1         20 print {$self->{fh}} $message->{message} or
281 1 50       2 return $self->_raise_error("unable to print to logfile: $!");
282              
283 1 50       5 if ($self->{filelock}) {
284 0 0       0 flock($self->{fh}, LOCK_UN)
285             or return $self->_raise_error("unable to unlock logfile $self->{filename}: $!");
286             }
287              
288 1 50       4 if (!$self->{fileopen}) {
289 1 50       5 $self->close or return undef;
290             }
291              
292 1         4 return 1;
293             }
294              
295             sub flush {
296 0     0 1 0 my $self = shift;
297              
298 0 0       0 if ($self->{fileopen}) {
299 0 0       0 $self->close or return undef;
300 0 0       0 $self->_open or return undef;
301             }
302              
303 0         0 return 1;
304             }
305              
306             sub close {
307 2     2 1 3 my $self = shift;
308              
309 2 100       6 if ($self->{fh}) {
310             CORE::close($self->{fh})
311 1 50       50 or return $self->_raise_error("unable to close logfile $self->{filename}: $!");
312 1         5 delete $self->{fh};
313             }
314              
315 2         8 return 1;
316             }
317              
318             sub validate {
319 1     1 1 2 my $self = shift;
320 1         2 my $opts = ();
321              
322 1         2 eval { $opts = $self->_validate(@_) };
  1         3  
323              
324 1 50       5 if ($@) {
325 0         0 return $self->_raise_error($@);
326             }
327              
328 1         3 return $opts;
329             }
330              
331             sub reload {
332 1     1 1 1626 my $self = shift;
333 1         6 my $opts = $self->validate(@_);
334              
335 1         4 $self->close;
336              
337 1         4 foreach my $key (keys %$opts) {
338 10         17 $self->{$key} = $opts->{$key};
339             }
340              
341 1 50       4 if ($self->{fileopen}) {
342 0 0       0 $self->_open
343             or croak $self->errstr;
344             }
345              
346 1         4 return 1;
347             }
348              
349             sub errstr {
350 0     0 1 0 return $ERRSTR;
351             }
352              
353             sub DESTROY {
354 3     3   4592 my $self = shift;
355              
356 3 50       451 if ($self->{fh}) {
357 0         0 CORE::close($self->{fh});
358             }
359             }
360              
361             #
362             # private stuff
363             #
364              
365             sub _open {
366 1     1   2 my $self = shift;
367              
368             sysopen(my $fh, $self->{filename}, $self->{mode}, $self->{permissions})
369 1 50       119 or return $self->_raise_error("unable to open logfile $self->{filename}: $!");
370              
371 1 50       6 if ($self->{autoflush}) {
372 0         0 my $oldfh = select $fh;
373 0         0 $| = $self->{autoflush};
374 0         0 select $oldfh;
375             }
376              
377 1 50       6 if ($self->{utf8}) {
    50          
378 0         0 binmode $fh, ":utf8";
379             } elsif ($self->{"utf-8"}) {
380 0         0 binmode $fh, "encoding(utf-8)";
381             }
382              
383 1 50       6 if ($self->{reopen}) {
384 0         0 $self->{inode} = (stat($self->{filename}))[1];
385             }
386              
387 1         4 $self->{fh} = $fh;
388 1         4 return 1;
389             }
390              
391             sub _check_dateext {
392 0     0   0 my $self = shift;
393              
394 0         0 my $filename = POSIX::strftime($self->{filename_pattern}, localtime);
395              
396 0 0       0 if ($self->{filename} ne $filename) {
397 0         0 $self->{filename} = $filename;
398 0 0       0 if ($self->{fileopen}) {
399 0 0       0 $self->close or return undef;
400 0 0       0 $self->_open or return undef;
401             }
402             }
403              
404 0         0 return 1;
405             }
406              
407             sub _checkino {
408 0     0   0 my $self = shift;
409              
410 0 0 0     0 if (!-e $self->{filename} || $self->{inode} != (stat($self->{filename}))[1]) {
411 0 0       0 $self->close or return undef;
412 0 0       0 $self->_open or return undef;
413             }
414              
415 0         0 return 1;
416             }
417              
418             sub _validate {
419 4     4   8 my $class = shift;
420 4         18 my $bool_rx = qr/^[10]\z/;
421              
422 4         132 my %opts = Params::Validate::validate(@_, {
423             filename => {
424             type => Params::Validate::SCALAR | Params::Validate::ARRAYREF,
425             },
426             filelock => {
427             type => Params::Validate::SCALAR,
428             regex => $bool_rx,
429             default => 1,
430             },
431             fileopen => {
432             type => Params::Validate::SCALAR,
433             regex => $bool_rx,
434             default => 1,
435             },
436             reopen => {
437             type => Params::Validate::SCALAR,
438             regex => $bool_rx,
439             default => 1,
440             },
441             mode => {
442             type => Params::Validate::SCALAR,
443             regex => qr/^(append|excl|trunc)\z/,
444             default => "append",
445             },
446             autoflush => {
447             type => Params::Validate::SCALAR,
448             regex => $bool_rx,
449             default => 1,
450             },
451             permissions => {
452             type => Params::Validate::SCALAR,
453             regex => qr/^[0-7]{3,4}\z/,
454             default => "0640",
455             },
456             utf8 => {
457             type => Params::Validate::SCALAR,
458             regex => $bool_rx,
459             default => 0,
460             },
461             "utf-8" => {
462             type => Params::Validate::SCALAR,
463             regex => $bool_rx,
464             default => 0,
465             },
466             dateext => {
467             type => Params::Validate::SCALAR,
468             optional => 1
469             }
470             });
471              
472 4 100       259 if (ref($opts{filename}) eq "ARRAY") {
473 3         7 $opts{filename} = File::Spec->catfile(@{$opts{filename}});
  3         33  
474             }
475              
476 4 100       19 if ($opts{mode} eq "append") {
    50          
    0          
477 2         5 $opts{mode} = O_WRONLY | O_APPEND | O_CREAT;
478             } elsif ($opts{mode} eq "excl") {
479 2         4 $opts{mode} = O_WRONLY | O_EXCL | O_CREAT;
480             } elsif ($opts{mode} eq "trunc") {
481 0         0 $opts{mode} = O_WRONLY | O_TRUNC | O_CREAT;
482             }
483              
484 4         14 $opts{permissions} = oct($opts{permissions});
485 4         9 $opts{filename_pattern} = $opts{filename};
486              
487 4         16 return \%opts;
488             }
489              
490             sub _raise_error {
491 0     0     $ERRSTR = $_[1];
492 0           return undef;
493             }
494              
495             1;