/usr/share/perl5/Log/Dispatch/File/Locked.pm is in liblog-dispatch-perl 2.67-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 | package Log::Dispatch::File::Locked;
use strict;
use warnings;
our $VERSION = '2.67';
use Fcntl qw(:DEFAULT :flock);
use base qw( Log::Dispatch::File );
sub log_message {
my $self = shift;
my %p = @_;
if ( $self->{close_after_write} ) {
$self->_open_file;
}
my $fh = $self->{fh};
flock( $fh, LOCK_EX )
or die "Cannot lock '$self->{filename}' for writing: $!";
# just in case there was an append while we waited for the lock
seek( $fh, 0, 2 )
or die "Cannot seek to end of '$self->{filename}': $!";
if ( $self->{syswrite} ) {
defined syswrite( $fh, $p{message} )
or die "Cannot write to '$self->{filename}': $!";
}
else {
print $fh $p{message}
or die "Cannot write to '$self->{filename}': $!";
}
flock( $fh, LOCK_UN ) or die "Cannot unlock '$self->{filename}'";
if ( $self->{close_after_write} ) {
close $fh
or die "Cannot close '$self->{filename}': $!";
delete $self->{fh};
}
}
1;
# ABSTRACT: Subclass of Log::Dispatch::File to facilitate locking
__END__
=pod
=encoding UTF-8
=head1 NAME
Log::Dispatch::File::Locked - Subclass of Log::Dispatch::File to facilitate locking
=head1 VERSION
version 2.67
=head1 SYNOPSIS
use Log::Dispatch;
my $log = Log::Dispatch->new(
outputs => [
[
'File::Locked',
min_level => 'info',
filename => 'Somefile.log',
mode => '>>',
newline => 1
]
],
);
$log->emerg("I've fallen and I can't get up");
=head1 DESCRIPTION
This module acts exactly like L<Log::Dispatch::File> except that it
obtains an exclusive lock on the file while opening it.
Note that if you are using this output because you want to write to a file
from multiple processes, you should open the file with the append C<mode>
(C<<< >> >>>), or else it's quite likely that one process will overwrite
another.
=head1 SEE ALSO
L<perlfunc/flock>
=head1 SUPPORT
Bugs may be submitted at L<https://github.com/houseabsolute/Log-Dispatch/issues>.
I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
=head1 SOURCE
The source code repository for Log-Dispatch can be found at L<https://github.com/houseabsolute/Log-Dispatch>.
=head1 AUTHOR
Dave Rolsky <autarch@urth.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2017 by Dave Rolsky.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
The full text of the license can be found in the
F<LICENSE> file included with this distribution.
=cut
|