File Coverage

blib/lib/Log/LTSV/Instance.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package Log::LTSV::Instance;
use 5.008001;
use strict;
use warnings;
use Time::Piece;
use File::RotateLogs;
use Data::Dumper;
use Carp;
use Log::LTSV::Instance::Flatten;

our $VERSION = "0.03";

my %LOG_LEVEL_MAP = (
    DEBUG    => 1,
    INFO     => 2,
    WARN     => 3,
    CRITICAL => 4,
    ERROR    => 99,
);

sub new {
    my ($class, %args) = @_;

    my $level = $LOG_LEVEL_MAP{$args{level} || 'DEBUG'};

    Carp::croak("level required ERROR or CRITICAL or WARN or INFO or DEBUG") unless $level;

    my ($logger, $rotatelogs);
    if ($args{logger}) {
        $logger = $args{logger};
    } elsif (not defined $args{logfile}) {
        $logger = sub { print @_ };
    } else {
        my $maxage = $args{maxage} || 60 * 60 * 24 * 1;
        my $rotatelogs = File::RotateLogs->new(
            logfile      => $args{logfile},
            maxage       => $maxage,
            $args{linkname} ? ( linkname     => $args{linkname} ) : (),
            $args{rotationtime} ? ( rotationtime => $args{rotationtime} ) : (),
        );
        $logger = sub { $rotatelogs->print(@_) };
    }

    my $flatten = Log::LTSV::Instance::Flatten->new;

    bless {
        rotatelogs  => $rotatelogs,
        logger      => $logger,
        level       => $level,
        sticks      => {},
        default_key => $args{default_key} || 'message',
        _flatten    => $flatten,
    }, $class;
}

sub error { shift->print('ERROR', @_) }
sub crit  { shift->print('CRITICAL', @_) }
sub warn  { shift->print('WARN', @_) }
sub info  { shift->print('INFO', @_) }
sub debug { shift->print('DEBUG', @_) }

sub sticks {
    my ($self, @args) = @_;
    while (@args) {
        my ($key, $value) = splice @args, 0, 2;
        $self->{sticks}{$key} = $value;
    }
}

sub _escape {
    my ($self, $val) = @_;

    $val =~ s/\t/\\t/;
    $val =~ s/\n/\\n/;

    return $val;
}

sub labeled_values {
    my ($self, $key, $value) = @_;
    my %lv = $self->{_flatten}->flatten($key, $value);
    $lv{$_} = $self->_escape($lv{$_}) for ( keys %lv );
    map { join ':', $_, $lv{$_} } keys %lv;
}

sub print {
    my ($self, $level, @args) = @_;
    return if ($LOG_LEVEL_MAP{$level} < $self->{level});

    if (ref $args[0] eq 'HASH') {
        @args = %{ $args[0] };
    } elsif ( scalar @args == 1 && ref $args[0] eq '' ) {
        @args = ( $self->{default_key} => $args[0] );
    }

    my @msgs;

    push @msgs, sprintf("time:%s", localtime->datetime);
    push @msgs, "log_level:$level";

    for my $key (keys %{ $self->{sticks} }) {
        my $value = $self->{sticks}->{$key};
        $value = $value->() if ref $value;
        push @msgs, $self->labeled_values($key, $value);
    }

    while (@args) {
        my ($key, $value) = splice @args, 0, 2;
        push @msgs, $self->labeled_values($key, $value);
    }
    my $ltsv = join "\t", @msgs;
    $self->{logger}->($ltsv."\n");
}

1;
__END__