File Coverage

blib/lib/Log/Dispatch/Gelf.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	10	12	83.3
condition	13	18	72.2
subroutine	16	16	100.0
pod	0	2	0.0
total	105	114	92.1

package Log::Dispatch::Gelf;
use 5.010;
use strict;
use warnings;

our $VERSION = '1.0.0';

use base qw(Log::Dispatch::Output);
use Params::Validate qw(validate SCALAR HASHREF CODEREF);

use Sys::Hostname;
use JSON;
use Time::HiRes qw(time);

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my $self = bless {}, $class;

    $self->_basic_init(@_);
    $self->_init(@_);

    return $self;
}

sub _init {
    my $self = shift;

    Params::Validate::validation_options(allow_extra => 1);
    my %p = validate(
        @_,
        {
            send_sub          => { type => CODEREF, optional => 1 },
            additional_fields => { type => HASHREF, optional => 1 },
            host              => { type => SCALAR,  optional => 1 },
            socket            => {
                type      => HASHREF,
                optional  => 1,
                callbacks => {
                    protocol_is_tcp_or_udp_or_default => sub {
                        my ($socket) = @_;

                        $socket->{protocol} //= 'udp';
                        die 'socket protocol must be tcp or udp' unless $socket->{protocol} =~ /^tcp|udp$/;
                    },
                    host_must_be_set => sub {
                        my ($socket) = @_;

                        die 'socket host must be set' unless exists $socket->{host} && length $socket->{host} > 0;
                    },
                    port_must_be_number_or_default => sub {
                        my ($socket) = @_;

                        $socket->{port} //= 12201;
                        die 'socket port must be integer' unless $socket->{port} =~ /^\d+$/;
                    }
                }
            }
        }
    );

    if (!defined $p{socket} && !defined $p{send_sub}) {
        die 'Must be set socket or send_sub';
    }

    $self->{host}              = $p{host}              // hostname();
    $self->{additional_fields} = $p{additional_fields} // {};
    $self->{send_sub}          = $p{send_sub};
    $self->{gelf_version}      = '1.1';

    if ($p{socket}) {
        my $socket = $self->_create_socket($p{socket});

        $self->{send_sub} = sub {
            my ($msg) = @_;

            $socket->send($msg);
        };
    }

    my $i = 0;
    $self->{number_of_loglevel}{$_} = $i++ for qw(emergency alert critical error warning notice info debug);

    return;
}

sub _create_socket {
    my ($self, $socket_opts) = @_;

    require IO::Socket::INET;
    return IO::Socket::INET->new(
        PeerAddr => $socket_opts->{host},
        PeerPort => $socket_opts->{port},
        Proto    => $socket_opts->{protocol},
    ) or die "Cannot create socket: $!";
}

sub log_message {
    my ($self, %p) = @_;
    (my $short_message = $p{message}) =~ s/\n.*//s;

    my %additional_fields;
    while (my ($key, $value) = each %{ $self->{additional_fields} }) {
        $additional_fields{"_$key"} = $value;
    }

    my $log_unit = {
        version       => $self->{gelf_version},
        host          => $self->{host},
        short_message => $short_message,
        timestamp     => time(),
        level         => $self->{number_of_loglevel}{ $p{level} },
        full_message  => $p{message},
        %additional_fields,
    };

    $self->{send_sub}->(to_json($log_unit, { canonical => 1 }) . "\n");

    return;
}

1;
__END__