From d67fdc44c47c2fba0b5c8c53d983a116c7a2db97 Mon Sep 17 00:00:00 2001 From: Florian Forster Date: Mon, 26 Mar 2007 14:41:01 +0200 Subject: [PATCH] Added Perl-module `Collectd::Unixsock' to contrib/ --- contrib/PerlLib/Collectd/Unixsock.pm | 153 +++++++++++++++++++++++++++++++++++ 1 file changed, 153 insertions(+) create mode 100644 contrib/PerlLib/Collectd/Unixsock.pm diff --git a/contrib/PerlLib/Collectd/Unixsock.pm b/contrib/PerlLib/Collectd/Unixsock.pm new file mode 100644 index 00000000..7afbe9d7 --- /dev/null +++ b/contrib/PerlLib/Collectd/Unixsock.pm @@ -0,0 +1,153 @@ +package Collectd::Unixsock; + +use strict; +use warnings; + +use Carp (qw(cluck confess)); +use IO::Socket::UNIX; +use Regexp::Common (qw(number)); + +return (1); + +sub _create_socket +{ + my $path = shift; + my $sock = IO::Socket::UNIX->new (Type => SOCK_STREAM, Peer => $path); + if (!$sock) + { + cluck ("Cannot open UNIX-socket $path: $!"); + return; + } + return ($sock); +} # _create_socket + +sub _create_identifier +{ + my $args = shift; + my $host; + my $plugin; + my $type; + + if (!$args->{'host'} || !$args->{'plugin'} || !$args->{'type'}) + { + cluck ("Need `host', `plugin' and `type'"); + return; + } + + $host = $args->{'host'}; + $plugin = $args->{'plugin'}; + $plugin .= '-' . $args->{'plugin_instance'} if ($args->{'plugin_instance'}); + $type = $args->{'type'}; + $type .= '-' . $args->{'type_instance'} if ($args->{'type_instance'}); + + return ("$host/$plugin/$type"); +} # _create_identifier + +sub new +{ + my $pkg = shift; + my $path = @_ ? shift : '/var/run/collectd-unixsock'; + my $sock = _create_socket ($path) or return; + my $obj = bless ( + { + path => $path, + sock => $sock, + error => 'No error' + }, $pkg); + return ($obj); +} # new + +sub getval +{ + my $obj = shift; + my %args = @_; + + my $status; + my $fh = $obj->{'sock'} or confess; + my $msg; + my $identifier; + + my $ret = {}; + + $identifier = _create_identifier (\%args) or return; + + $msg = "GETVAL $identifier\n"; + send ($fh, $msg, 0) or confess ("send: $!"); + + $msg = undef; + recv ($fh, $msg, 1024, 0) or confess ("recv: $!"); + + ($status, $msg) = split (' ', $msg, 2); + if ($status <= 0) + { + $obj->{'error'} = $msg; + return; + } + + for (split (' ', $msg)) + { + my $entry = $_; + if ($entry =~ m/^(\w+)=($RE{num}{real})$/) + { + $ret->{$1} = 0.0 + $2; + } + } + + return ($ret); +} # getval + +sub putval +{ + my $obj = shift; + my %args = @_; + + my $status; + my $fh = $obj->{'sock'} or confess; + my $msg; + my $identifier; + my $values; + + $identifier = _create_identifier (\%args) or return; + if (!$args{'values'}) + { + cluck ("Need argument `values'"); + return; + } + + if (!ref ($args{'values'})) + { + $values = $args{'values'}; + } + else + { + my $time = $args{'time'} ? $args{'time'} : time (); + $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}})); + } + + $msg = "PUTVAL $identifier $values\n"; + send ($fh, $msg, 0) or confess ("send: $!"); + $msg = undef; + recv ($fh, $msg, 1024, 0) or confess ("recv: $!"); + + ($status, $msg) = split (' ', $msg, 2); + return (1) if ($status == 0); + + $obj->{'error'} = $msg; + return; +} # putval + +sub destroy +{ + my $obj = shift; + if ($obj->{'sock'}) + { + close ($obj->{'sock'}); + delete ($obj->{'sock'}); + } +} + +sub DESTROY +{ + my $obj = shift; + $obj->destroy (); +} -- 2.11.0