From: Florian Forster <octo@leeloo.lan.home.verplant.org>
Date: Mon, 26 Mar 2007 12:41:01 +0000 (+0200)
Subject: Added Perl-module `Collectd::Unixsock' to contrib/
X-Git-Tag: collectd-4.0.0-rc4~55
X-Git-Url: https://git.tokkee.org/?a=commitdiff_plain;h=d67fdc44c47c2fba0b5c8c53d983a116c7a2db97;p=collectd.git

Added Perl-module `Collectd::Unixsock' to contrib/
---

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 ();
+}