File Coverage

blib/lib/Logging/Simple.pm

Criterion	Covered	Total	%
statement	180	180	100.0
branch	98	102	96.0
condition	20	24	83.3
subroutine	25	25	100.0
pod	12	12	100.0
total	335	343	97.6

package Logging::Simple;
use 5.007;
use strict;
use warnings;

use Carp qw(croak confess);
use POSIX qw(strftime);
use Time::HiRes qw(time);

our $VERSION = '1.04';

BEGIN {

    sub _sub_names { return [qw(_0 _1 _2 _3 _4 _5 _6 _7)]; };
    my $sub_names = _sub_names();

    # build the level subs dynamically. The code in this BEGIN block represents
    # all logging subs

    {
        no strict 'refs';

        for (@$sub_names) {
            my $sub = $_;

            *$_ = sub {
                my ($self, $msg) = @_;

                return if $self->level == -1;

                $self->level($ENV{LS_LEVEL}) if defined $ENV{LS_LEVEL};

                if ($sub =~ /^_(\d)$/) {
                    if (defined $self->_log_only) {
                        return if $1 != $self->_log_only;
                    }
                    return if $1 > $self->level;
                }

                my $proc = join '|', (caller(0))[1..2];

                my %log_entry = (
                    label => $sub,
                    proc => $proc,
                    msg => $msg,
                );
                $self->_generate_entry(%log_entry);
            }
        }
    }
}
sub new {
    my ($class, %args) = @_;

    my $self = bless {}, $class;

    if (defined $args{level}) {
        $self->level($args{level});
    }
    else {
        my $lvl = defined $ENV{LS_LEVEL} ? $ENV{LS_LEVEL} : 4;
        $self->level($lvl);
    }

    if ($args{file}){
        $self->file($args{file}, $args{write_mode});
    }

    my $print = defined $args{print} ? $args{print} : 1;
    $self->print($print);

    $self->display(
            time  => 1,
            label => 1,
            name  => 1,
            pid   => 0,
            proc  => 0,
    );

    if (defined $args{display}){
        $self->display($args{display});
    }

    $self->name($args{name});

    return $self;
}
sub level {
    my ($self, $level) = @_;

    my %levels = $self->levels;

    $self->{level} = $ENV{LS_LEVEL} if defined $ENV{LS_LEVEL};
    my $lvl;

    if (defined $level && $level =~ /^-1$/){
        $self->{level} = $level;
    }
    elsif (defined $level){
        my $log_only;

        if ($level =~ /^=/){
            $level =~ s/=//;
            $log_only = 1;
        }
        if ($level =~ /^\d$/ && defined $levels{$level}){
            $self->{level} = $level;
        }
        else {
            warn "invalid level $level specified, using default of 4\n";
        }

        if ($log_only){
            $self->_log_only($self->{level});
        }
        else {
            $self->_log_only(-1);
        }
    }

    return $self->{level};
}
sub file {
    my ($self, $file, $mode) = @_;

    if (! defined $file){
        return $self->{file};
    }
    if ($file =~ /^0$/){
        if (tell($self->{fh}) != -1) {
            close $self->{fh};
        }
        delete $self->{file};
        delete $self->{fh};
        return;
    }
    if (defined $file && $self->{file} && $file ne $self->{file}){
        close $self->{fh};
    }
    $mode = 'a' if ! defined $mode;
    my $op = $mode =~ /^a/ ? '>>' : '>';

    open $self->{fh}, $op, $file or croak "can't open log file for writing: $!";
    $self->{file} = $file;

    return $self->{file};
}
sub name {
    my ($self, $name) = @_;
    $self->{name} = $name if defined $name;
    return $self->{name};
}
sub timestamp {
    my $t = time;
    my $date = strftime "%Y-%m-%d %H:%M:%S", localtime $t;
    $date .= sprintf ".%03d", ($t-int($t))*1000; # without rounding
    return $date;
}
sub levels {
    my ($self, $lvl) = @_;

    my %levels = $self->_levels;

    return $levels{$lvl} if defined $lvl;
    return %levels;
}
sub labels {
    my ($self, $labels) = @_;
    $self->_levels($labels);
}
sub display {
    my $self = shift;
    my ($tag, %tags);

    if (@_ == 1){
        $tag = shift;
    }
    else {
        %tags = @_;
    }

    if (defined $tag){
        if ($tag =~ /^0$/){
            for (keys %{ $self->{display} }){
                $self->{display}{$_} = 0;
            }
            return 0;
        }
        if ($tag =~ /^1$/){
            for (keys %{ $self->{display} }){
                $self->{display}{$_} = 1;
            }
            return 1;
        }

        return $self->{display}{$tag};
    }

    my %valid = (
        name => 0,
        time => 0,
        label => 0,
        pid => 0,
        proc => 0,
    );

    for (keys %tags) {
        if (! defined $valid{$_}){
            warn "$_ is an invalid tag...skipping\n";
            next;
        }
        $self->{display}{$_} = $tags{$_};
    }

    return %{ $self->{display} };
}
sub print {
    $_[0]->{print} = $_[1] if defined $_[1];
    return $_[0]->{print};
}
sub child {
    my ($self, $name) = @_;
    my $child = bless { %$self }, ref $self;
    $name = $self->name . ".$name" if defined $self->name;
    $child->name($name);
    return $child;
}
sub custom_display {
    my ($self, $disp) = @_;

    if (defined $disp) {
        if ($disp =~ /^0$/) {
            delete $self->{custom_display};
            return 0;
        }
        else {
            $self->{custom_display} = $disp;
        }
    }
    return $self->{custom_display};
}
sub fatal {
    my ($self, $msg) = @_;
    $self->display(1);
    confess("\n" . $self->_0("$msg"));
}
sub _generate_entry {
    # builds/formats the log entry line

    my $self = shift;
    my %entry = @_;

    my $label = $entry{label};
    my $proc = $entry{proc};
    my $msg = $entry{msg};

    my $subs = $self->_sub_names;
    if (! grep { $label eq $_ } @$subs){
        croak "_generate_entry() requires a label => sub/label param\n";
    }

    $label =~ s/_//;
    $label = $self->levels($label);

    $msg = $msg ? "$msg\n" : "\n";

    my $log_entry;
    $log_entry .= $self->custom_display if defined $self->custom_display;
    $log_entry .= "[".$self->timestamp()."]" if $self->display('time');
    $log_entry .= "[$label]" if $self->display('label');
    $log_entry .= "[".$self->name."]" if $self->display('name') && $self->name;
    $log_entry .= "[$$]" if $self->display('pid');
    $log_entry .= "[$proc]" if $self->display('proc');
    $log_entry .= " " if $log_entry;
    $log_entry .= $msg;

    return $log_entry if ! $self->print;

    if ($self->{fh}){
        print { $self->{fh} } $log_entry;
    }
    else {
        print $log_entry;
    }
}
sub _levels {
    # manages the level labels

    my ($self, $labels) = @_;

    if (ref $labels eq 'ARRAY'){
        croak "must supply exactly 8 custom labels\n" if @$labels != 8;
        my %custom_levels = map {$_ => $labels->[$_]} (0..7);
        $self->{labels} = \%custom_levels;
    }

    if (defined $labels && $labels == 0 || ! defined $self->{labels}) {
        $self->{labels} = {
            0 => 'lvl 0',
            1 => 'lvl 1',
            2 => 'lvl 2',
            3 => 'lvl 3',
            4 => 'lvl 4',
            5 => 'lvl 5',
            6 => 'lvl 6',
            7 => 'lvl 7',
        };
    }
    return %{ $self->{labels} };
}
sub _log_only {
    # are we logging only one level or not?

    my ($self, $level) = @_;
    if (defined $level && $level == -1){
        $self->{log_only} = undef;
    }
    else {
        $self->{log_only} = $level if defined $level;
    }
    return $self->{log_only};
}

1;
__END__