File Coverage

lib/Haineko/Log.pm

Criterion	Covered	Total	%
statement	48	71	67.6
branch	9	40	22.5
condition	15	26	57.6
subroutine	8	8	100.0
pod	2	4	50.0
total	82	149	55.0

package Haineko::Log;
use strict;
use warnings;

use Sys::Syslog qw(:DEFAULT setlogsock);
use Class::Accessor::Lite;

my $rwaccessors = [
    'facility',     # (String) syslog facility
    'loglevel',     # (String) default log level
    'disabled',     # (Integer) syslog disabled
    'option',       # (HashRef) Logging options
];
my $roaccessors = [
    'identity',     # (String) Log identiy string
    'queueid',      # (String) Queue ID
    'useragent',    # (String) User agent name
    'remoteaddr',   # (String) Client IP address
    'remoteport',   # (String) Client port number
];

Class::Accessor::Lite->mk_accessors( @$rwaccessors );
Class::Accessor::Lite->mk_ro_accessors( @$roaccessors );

# Set prefix or suffix into the log message
#  Emergency     (level 0)
#  Alert         (level 1)
#  Critical      (level 2)
#  Error         (level 3)
#  Warning       (level 4)
#  Notice        (level 5)
#  Info          (level 6)
#  Debug         (level 7)
my $LogLevels = [
    'emerg', 'alert', 'crit', 'err' ,
    'warning', 'notice', 'info', 'debug',
];

sub new {
    my $class = shift;
    my $argvs = { @_ };

    my $logoptions = {
        'cons'    => 0,
        'ndelay'  => 1,
        'noeol'   => 0,
        'nofatal' => 1,
        'nonul'   => 0,
        'nowait'  => 0,
        'perror'  => 0,
        'pid'     => 1,
    };

    $argvs->{'facility'}   ||= 'local2';
    $argvs->{'loglevel'}   ||= 'info';
    $argvs->{'loglevel'}     = 'info' unless grep { $argvs->{'loglevel'} eq $_ } @$LogLevels;
    $argvs->{'disabled'}   //= 0;
    $argvs->{'identity'}     = 'haineko';
    $argvs->{'queueid'}    //= q();
    $argvs->{'useragent'}  ||= q();
    $argvs->{'remoteaddr'} ||= q();
    $argvs->{'remoteport'} //= q();

    if( defined $argvs->{'option'} && ref $argvs->{'option'} eq 'HASH' ) {
        # Set logging options
        for my $e ( keys %$logoptions ) {
            $argvs->{'option'}->{ $e } //= $logoptions->{ $e };
        }

    } else {
        $argvs->{'option'} = $logoptions;
    }

    return bless $argvs, __PACKAGE__;
}

sub o {
    # Return syslog option as a string
    my $self = shift;
    my $opts = [ grep { $_ if $self->{'options'}->{ $_ } } keys %{ $self->{'options'} } ];
    return join( ',', @$opts );
}

sub h {
    # Return syslog header string
    my $self = shift;
    my $head = [];
    my $host = q();

    push @$head, sprintf( "queueid=%s", $self->{'queueid'} ) if $self->{'queueid'};
    $host  = sprintf( "client=%s", $self->{'remoteaddr'} ) if $self->{'remoteaddr'};
    $host .= sprintf( ":%d", $self->{'remoteport'} ) if $host && $self->{'remoteport'};
    push @$head, $host if length $host;
    push @$head, sprintf( "ua='%s'", $self->{'useragent'} ) if $self->{'useragent'};

    return q() unless scalar @$head;
    return join( ', ', @$head );
}

sub w {
    # write messages
    my $self = shift;
    my $sllv = shift || $self->{'loglevel'};
    my $mesg = shift;
    my $text = q();
    my $logs = [];

    return 0 if $self->{'disabled'};
    return 0 unless ref $mesg eq 'HASH';

    $sllv = 'info' unless grep { $sllv eq $_ } @$LogLevels;
    push @$logs, $self->h;

    for my $e ( keys %$mesg ) {

        next if ref $mesg->{ $e };
        next unless $mesg->{ $e };
        $text = $mesg->{ $e };
        $text = sprintf( "'%s'", $text ) if $text =~ m/\s/;
        push @$logs, sprintf( "%s=%s", $e, $text );
    }

    if( defined $mesg->{'message'} ) {

        if( ref $mesg->{'message'} eq 'ARRAY' ) {
            $text = sprintf( "message='%s'", join( ' | ', @{ $mesg->{'message'} } ) );
            push @$logs, $text;

        } else {
            push @$logs, sprintf( "message=%s", $mesg->{'message'} );
        }
    }

    openlog( $self->{'identify'}, $self->o, $self->{'facility'} ) || return 0;
    syslog( $sllv, join( ', ', @$logs ) ) || return 0;
    closelog || return 0;
    return 1;
}

1;
__END__