=head1 NAME
Log::Handler::Output::Socket - Send messages to a socket.
=head1 SYNOPSIS
use Log::Handler::Output::Socket;
my $sock = Log::Handler::Output::Socket->new(
peeraddr => "127.0.0.1",
peerport => 44444,
proto => "tcp",
timeout => 10
);
$sock->log(message => $message);
=head1 DESCRIPTION
With this module it's possible to send messages over the network.
=head1 METHODS
=head2 new()
Call C<new()> to create a new Log::Handler::Output::Socket object.
The following options are possible:
=over 4
=item B<peeraddr>
The address of the server.
=item B<peerport>
The port to connect to.
=item B<proto>
The protocol you wish to use. Default is TCP.
=item B<timeout>
The timeout to send message. The default is 5 seconds.
=item B<persistent> and B<reconnect>
With this option you can enable or disable a persistent connection and
re-connect if the connection was lost.
Both options are set to 1 on default.
=item B<dump>
Do you like to dump the message? If you enable this option then all
messages will be dumped with C<Data::Dumper>.
=item B<dumper>
Do you want to use another dumper as C<Data::Dumper>? You can do the
following as example:
use Convert::Bencode_XS;
dumper => sub { Convert::Bencode_XS::bencode($_[0]) }
# or maybe
use JSON::PC;
dumper => sub { JSON::PC::convert($_[0]) }
=item B<connect>
This option is only useful if you want to pass your own arguments to
C<IO::Socket::INET> and don't want use C<peeraddr> and C<peerhost>.
Example:
connect => {
PerrAddr => "127.0.0.1",
PeerPort => 44444,
LocalPort => 44445
}
This options are passed to C<IO::Socket::INET>.
=back
=head2 log()
Call C<log()> if you want to send a message over the socket.
Example:
$sock->log("message");
=head2 connect()
Connect to the socket.
=head2 disconnect()
Disconnect from socket.
=head2 validate()
Validate a configuration.
=head2 reload()
Reload with a new configuration.
=head2 errstr()
This function returns the last error message.
=head1 PREREQUISITES
Carp
Params::Validate;
IO::Socket::INET;
Data::Dumper;
=head1 EXPORTS
No exports.
=head1 REPORT BUGS
Please report all bugs to <jschulz.cpan(at)bloonix.de>.
If you send me a mail then add Log::Handler into the subject.
=head1 AUTHOR
Jonny Schulz <jschulz.cpan(at)bloonix.de>.
=head1 COPYRIGHT
Copyright (C) 2007-2009 by Jonny Schulz. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
package Log::Handler::Output::Socket;
use strict;
use warnings;
use Carp;
use Data::Dumper;
use IO::Socket::INET;
use Params::Validate qw();
our $VERSION = "0.08";
our $ERRSTR = "";
sub new {
my $class = shift;
my $opts = $class->_validate(@_);
my $self = bless $opts, $class;
if ($self->{persistent}) {
$self->connect
or croak $self->errstr;
}
return $self;
}
sub log {
my $self = shift;
my $message = @_ > 1 ? {@_} : shift;
my $socket = ();
if ($self->{dump}) {
$message->{message} = $self->{dumper}(@_ > 1 ? {@_} : shift);
}
if ($self->{persistent} && $self->{socket}) {
$socket = $self->{socket};
} else {
$socket = $self->connect
or return undef;
}
# If the peer is done then send() croaks
eval { $socket->send($message->{message}) };
if ($@) {
if ($self->{persistent} && $self->{reconnect}) {
$self->connect or return undef;
eval { $socket->send($message->{message}) };
if ($@) {
return $self->_raise_error("something curious happends: $@");
}
} else {
return $self->_raise_error("unable to send message: $@");
}
}
if (!$self->{persistent}) {
$self->disconnect;
}
return 1;
}
sub connect {
my $self = shift;
my $opts = ();
if (@_) {
$opts = @_ > 1 ? {@_} : shift;
} else {
$opts = $self->{sockopts};
}
$self->{socket} = IO::Socket::INET->new(%$opts)
or return $self->_raise_error("unable to connect - $!");
return $self->{socket};
}
sub disconnect {
my $self = shift;
if ($self->{socket}) {
$self->{socket}->close;
}
delete $self->{socket};
}
sub validate {
my $self = shift;
my $opts = ();
eval { $opts = $self->_validate(@_) };
if ($@) {
return $self->_raise_error($@);
}
return $opts;
}
sub reload {
my $self = shift;
my $opts = $self->validate(@_);
$self->disconnect;
foreach my $key (keys %$opts) {
$self->{$key} = $opts->{$key};
}
if ($self->{persistent}) {
$self->connect
or croak $self->errstr;
}
return 1;
}
sub errstr {
return $ERRSTR;
}
sub DESTROY {
my $self = shift;
if ($self->{socket}) {
$self->{socket}->close;
}
}
#
# private stuff
#
sub _validate {
my $class = shift;
my %options = Params::Validate::validate(@_, {
connect => {
type => Params::Validate::HASHREF,
optional => 1,
},
peeraddr => {
type => Params::Validate::SCALAR,
optional => 1,
},
peerport => {
type => Params::Validate::SCALAR,
optional => 1,
},
proto => {
type => Params::Validate::SCALAR,
default => "tcp",
},
timeout => {
type => Params::Validate::SCALAR,
default => 5,
},
persistent => {
type => Params::Validate::SCALAR,
regex => qr/^[01]\z/,
default => 1,
},
reconnect => {
type => Params::Validate::SCALAR,
regex => qr/^[01]\z/,
default => 1,
},
dump => {
type => Params::Validate::SCALAR,
regex => qr/^[01]\z/,
default => 0,
},
dumper => {
type => Params::Validate::CODEREF,
default => \&Dumper,
},
});
if ($options{peeraddr} && $options{peerport}) {
$options{sockopts}{PeerAddr} = delete $options{peeraddr};
$options{sockopts}{PeerPort} = delete $options{peerport};
$options{sockopts}{Proto} = delete $options{proto};
$options{sockopts}{Timeout} = delete $options{timeout};
} elsif (!$options{connect}) {
Carp::croak "missing mandatory parameter connect or peeraddr/peerport";
}
return \%options;
}
sub _raise_error {
$ERRSTR = $_[1];
return undef;
}
1;