File Coverage

blib/lib/Dancer/Logger/File.pm

Criterion	Covered	Total	%
statement	52	61	85.2
branch	16	28	57.1
condition	11	24	45.8
subroutine	11	11	100.0
pod	2	2	100.0
total	92	126	73.0

package Dancer::Logger::File;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: file-based logging engine for Dancer
$Dancer::Logger::File::VERSION = '1.3514_04'; # TRIAL
$Dancer::Logger::File::VERSION = '1.351404';
use strict;
use warnings;
use Carp;
use base 'Dancer::Logger::Abstract';

use Dancer::Config 'setting';
use Dancer::FileUtils qw(open_file);
use IO::File;
use Fcntl qw(:flock SEEK_END);

sub logdir {
    if ( my $altpath = setting('log_path') ) {
        return $altpath;
    }

    my $logroot = setting('appdir');

    if ( $logroot and ! -d $logroot and ! mkdir $logroot ) {
        carp "app directory '$logroot' doesn't exist, am unable to create it";
        return;
    }

    my $expected_path = $logroot                                  ?
                        Dancer::FileUtils::path($logroot, 'logs') :
                        Dancer::FileUtils::path('logs');

    return $expected_path if -d $expected_path && -x _ && -w _;

    unless (-w $logroot and -x _) {
        my $perm = (stat $logroot)[2] & 07777;
        chmod($perm | 0700, $logroot);
        unless (-w $logroot and -x _) {
            carp "app directory '$logroot' isn't writable/executable and can't chmod it";
            return;
        }
    }
    return $expected_path;
}

sub init {
    my $self = shift;
    $self->SUPER::init(@_);

    my $logdir = logdir();
    return unless ($logdir);

    my $logfile = setting('log_file') || setting('environment').".log";

    mkdir($logdir) unless(-d $logdir);
    $logfile = File::Spec->catfile($logdir, $logfile);

    my $fh;
    unless($fh = open_file('>>', $logfile)) {
        carp "unable to create or append to $logfile";
        return;
    }

    # looks like older perls don't auto-convert to IO::File
    # and can't autoflush
    # see https://github.com/PerlDancer/Dancer/issues/954
    eval { $fh->autoflush };

    $self->{logfile} = $logfile;
    $self->{fh} = $fh;
}

sub _log {
    my ($self, $level, $message) = @_;
    my $fh = $self->{fh};

    return unless(ref $fh && $fh->opened);

    flock($fh, LOCK_EX)
        or carp "locking logfile $self->{logfile} failed";
    seek($fh, 0, SEEK_END)
        or carp "seeking to logfile $self->{logfile} end failed";
    $fh->print($self->format_message($level => $message))
        or carp "writing to logfile $self->{logfile} failed";
    flock($fh, LOCK_UN)
        or carp "unlocking logfile $self->{logfile} failed";

}

1;

__END__