File Coverage

blib/lib/Log/Dispatch/Socket.pm

Criterion	Covered	Total	%
statement	18	49	36.7
branch	0	12	0.0
condition	0	3	0.0
subroutine	6	11	54.5
pod	2	2	100.0
total	26	77	33.7

#
# This file is part of Log-Dispatch-Socket
#
# This software is copyright (c) 2012 by Loïc TROCHET.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
package Log::Dispatch::Socket;
{
  $Log::Dispatch::Socket::VERSION = '0.130020';
}
# ABSTRACT: Subclass of Log::Dispatch::Output that log messages to a socket

use strict;
use warnings;

use IO::Socket::INET;
use Params::Validate qw(validate SCALAR);

use Log::Dispatch::Output;
use parent qw(Log::Dispatch::Output);

Params::Validate::validation_options( allow_extra => 1 );


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

    my $self = validate
    (
        @_
    ,   {
            PeerHost   => { type => SCALAR, default => 'localhost' }
        ,   PeerPort   => { type => SCALAR                         }
        ,   Proto      => { type => SCALAR, default =>       'tcp' }
        }
    );

    bless $self, $class;

    $self->_basic_init(%$self);

    $self->{Attempt} = 0;
    $self->{Socket} = undef;

    die "Connect to '$self->{PeerHost}:$self->{PeerPort}' failed: $!"
        unless $self->_connect(%$self);

    return $self;
}

sub _connect
{
    my $self = shift;
    return $self->{Socket} = IO::Socket::INET->new(@_);
}

sub _disconnect
{
    my $self = shift;

    if (defined $self->{Socket})
    {
        eval { close $self->{Socket}; };
        undef $self->{Socket};
    }
}


sub log_message
{
    my ($self, %params) = @_;

    RETRY:
    {
        unless (defined $self->{Socket})
        {
            return if $self->{Attempt};
            $self->{Attempt} += 1;
            unless ($self->_connect(%$self))
            {
                die "Disconnect from '$self->{PeerHost}:$self->{PeerPort}'";
                return;
            }
            $self->{Attempt} = 0;
        }

        eval { $self->{Socket}->send($params{message}); };

        if ($@)
        {
            $self->_disconnect;
            redo RETRY;
        }
    }
}


sub DESTROY
{
    $_[0]->_disconnect;
}

1;

__END__