File Coverage

blib/lib/Log/ger/Output/File.pm

Criterion	Covered	Total	%
statement	40	47	85.1
branch	16	30	53.3
condition	8	14	57.1
subroutine	7	8	87.5
pod	0	2	0.0
total	71	101	70.3

## no critic (InputOutput::RequireBriefOpen)

package Log::ger::Output::File;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2020-03-11'; # DATE
our $DIST = 'Log-ger-Output-File'; # DIST
our $VERSION = '0.012'; # VERSION

use strict;
use warnings;

# supply object methods for filehandles, required for older perls e.g. 5.10
use FileHandle;

our %lock_handles;

sub meta { +{
    v => 2,
} }

sub get_hooks {
    my %plugin_conf = @_;

    my $lazy      = $plugin_conf{lazy};
    my $autoflush = $plugin_conf{autoflush}; $autoflush = 1 unless defined $autoflush;
    my $lock_mode = $plugin_conf{lock_mode} || 'none';

    (defined($plugin_conf{path}) || $plugin_conf{handle}) or
        die "Please specify 'path' or 'handle'";
    $lock_mode =~ /\A(none|write|exclusive)\z/ or
        die "Invalid lock_mode, please choose none|write|exclusive";
    $lock_mode ne 'none' && $plugin_conf{handle} and
        die "Locking using handle not supported for now";

    my $code_lock = sub {
        require File::Flock::Retry;
        my $key = defined($plugin_conf{path}) ? ":$plugin_conf{path}" : $plugin_conf{handle};
        if ($lock_handles{$key}) {
            return $lock_handles{$key};
        }
        $lock_handles{$key} = File::Flock::Retry->lock("$plugin_conf{path}.lck");
        #Scalar::Util::weaken($lock_handles{$key});
        # XXX how do we purge old %lock_handles keys?
        return $lock_handles{$key};
    };

    my $fh;
    my $code_open = sub {
        return if $fh;
        if (defined(my $path = $plugin_conf{path})) {
            open $fh, ">>", $path or die "Can't open log file '$path': $!";
        } else {
            $fh = $plugin_conf{handle};
        }
        $fh;
    };

    if ($lock_mode eq 'exclusive') {
        $code_lock->();
    }

    $code_open->() unless $lazy;

    return {
        create_outputter => [
            __PACKAGE__, # key
            50,          # priority
            sub {        # hook
                my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"

                my $outputter = sub {
                    my ($per_target_conf, $msg, $per_msg_conf) = @_;
                    my $lock_handle;
                    $code_open->() if $lazy && !$fh;
                    $lock_handle = $code_lock->() if $lock_mode eq 'write';
                    print $fh $msg;
                    print $fh "\n" unless $msg =~ /\R\z/;
                    $fh->flush if $autoflush || $lock_handle;
                    undef $lock_handle;
                };
                [$outputter];
            }],
    };
}

1;
# ABSTRACT: Send logs to file

__END__