From: Sebastian Harl Date: Sun, 30 Sep 2007 22:08:43 +0000 (+0200) Subject: Moved contrib/PerlLib/ to bindings/perl/. X-Git-Tag: collectd-4.2.0~52 X-Git-Url: https://git.tokkee.org/?a=commitdiff_plain;h=a459afe5f3097680f41e56b9cafa1198294ce8fc;p=collectd.git Moved contrib/PerlLib/ to bindings/perl/. Added bindings/Makefile.am and bindings/perl/Collectd/Makefile.PL, bindings/perl/Makefile.PL to integrate the Perl modules into the build system and the official distribution. Signed-off-by: Sebastian Harl --- diff --git a/Makefile.am b/Makefile.am index 34c36cc0..dfef7dd4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,4 +1,4 @@ -SUBDIRS = libltdl src +SUBDIRS = libltdl src bindings INCLUDES = $(LTDLINCL) diff --git a/bindings/Makefile.am b/bindings/Makefile.am new file mode 100644 index 00000000..37e31ea1 --- /dev/null +++ b/bindings/Makefile.am @@ -0,0 +1,18 @@ +EXTRA_DIST = perl/Collectd.pm perl/Makefile.PL perl/Collectd/Makefile.PL perl/Collectd/Unixsock.pm + +all-local: @PERL_BINDINGS@ + +install-exec-local: + [ ! -f perl/Makefile ] || $(MAKE) -C perl install + +clean-local: + [ ! -f perl/Makefile ] || $(MAKE) -C perl realclean + +perl: perl/Makefile + $(MAKE) -C perl + +perl/Makefile: perl/Makefile.PL perl/Collectd/Makefile.PL + cd perl && @PERL@ Makefile.PL PREFIX=$(prefix) @PERL_BINDINGS_OPTIONS@ + +.PHONY: perl + diff --git a/bindings/perl/Collectd.pm b/bindings/perl/Collectd.pm new file mode 100644 index 00000000..0c6c6c80 --- /dev/null +++ b/bindings/perl/Collectd.pm @@ -0,0 +1,52 @@ +# collectd - Collectd.pm +# Copyright (C) 2007 Sebastian Harl +# +# This program is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation; only version 2 of the License is applicable. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +# +# Author: +# Sebastian Harl + +package Collectd; + +use strict; +use warnings; + +require Exporter; + +our @ISA = qw( Exporter ); + +our %EXPORT_TAGS = ( + 'funcs' => [ qw( plugin_register plugin_unregister + plugin_dispatch_values plugin_log ) ], + 'types' => [ qw( TYPE_INIT TYPE_READ TYPE_WRITE TYPE_SHUTDOWN TYPE_LOG + TYPE_DATASET ) ], + 'ds_types' => [ qw( DS_TYPE_COUNTER DS_TYPE_GAUGE ) ], + 'log' => [ qw( LOG_ERR LOG_WARNING LOG_NOTICE LOG_INFO LOG_DEBUG ) ], +); + +{ + my %seen; + + push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}} + foreach keys %EXPORT_TAGS; +} + +Exporter::export_ok_tags('all'); + +bootstrap Collectd "4.1.2"; + +1; + +# vim: set sw=4 ts=4 tw=78 noexpandtab : + diff --git a/bindings/perl/Collectd/Makefile.PL b/bindings/perl/Collectd/Makefile.PL new file mode 100644 index 00000000..be0ec91c --- /dev/null +++ b/bindings/perl/Collectd/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + 'NAME' => 'Collectd::Unixsock', + 'VERSION' => '4.1.2', + 'AUTHOR' => 'Florian Forster ', +); + +# vim: set sw=4 ts=4 tw=78 noexpandtab : diff --git a/bindings/perl/Collectd/Unixsock.pm b/bindings/perl/Collectd/Unixsock.pm new file mode 100644 index 00000000..3b8a91cf --- /dev/null +++ b/bindings/perl/Collectd/Unixsock.pm @@ -0,0 +1,322 @@ +package Collectd::Unixsock; + +=head1 NAME + +Collectd::Unixsock - Abstraction layer for accessing the functionality by collectd's unixsock plugin. + +=head1 SYNOPSIS + + use Collectd::Unixsock (); + + my $sock = Collectd::Unixsock->new ($path); + + my $value = $sock->getval (%identifier); + $sock->putval (%identifier, + time => time (), + values => [123, 234, 345]); + + $sock->destroy (); + +=head1 DESCRIPTION + +collectd's unixsock plugin allows external programs to access the values it has +collected or received and to submit own values. This Perl-module is simply a +little abstraction layer over this interface to make it even easier for +programmers to interact with the daemon. + +=cut + +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 + +=head1 VALUE IDENTIFIER + +The values in the collectd are identified using an five-tupel (host, plugin, +plugin-instance, type, type-instance) where only plugin-instance and +type-instance may be NULL (or undefined). Many functions expect an +I<%identifier> hash that has at least the members B, B, and +B, possibly completed by B and B. + +Usually you can pass this hash as follows: + + $obj->method (host => $host, plugin => $plugin, type => $type, %other_args); + +=cut + +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 (defined ($args->{'plugin_instance'})); + $type = $args->{'type'}; + $type .= '-' . $args->{'type_instance'} if (defined ($args->{'type_instance'})); + + return ("$host/$plugin/$type"); +} # _create_identifier + +sub _parse_identifier +{ + my $string = shift; + my $host; + my $plugin; + my $plugin_instance; + my $type; + my $type_instance; + my $ident; + + ($host, $plugin, $type) = split ('/', $string); + + ($plugin, $plugin_instance) = split ('-', $plugin, 2); + ($type, $type_instance) = split ('-', $type, 2); + + $ident = + { + host => $host, + plugin => $plugin, + type => $type + }; + $ident->{'plugin_instance'} = $plugin_instance if (defined ($plugin_instance)); + $ident->{'type_instance'} = $type_instance if (defined ($type_instance)); + + return ($ident); +} # _parse_identifier + +=head1 PUBLIC METHODS + +=over 4 + +=item I<$obj> = Collectd::Unixsock->B ([I<$path>]); + +Creates a new connection to the daemon. The optional I<$path> argument gives +the path to the UNIX socket of the C and defaults to +F. Returns the newly created object on success and +false on error. + +=cut + +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 + +=item I<$res> = I<$obj>-EB (I<%identifier>); + +Requests a value-list from the daemon. On success a hash-ref is returned with +the name of each data-source as the key and the according value as, well, the +value. On error false is returned. + +=cut + +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"; + #print "-> $msg"; + send ($fh, $msg, 0) or confess ("send: $!"); + + $msg = undef; + recv ($fh, $msg, 1024, 0) or confess ("recv: $!"); + #print "<- $msg"; + + ($status, $msg) = split (' ', $msg, 2); + if ($status <= 0) + { + $obj->{'error'} = $msg; + return; + } + + for (split (' ', $msg)) + { + my $entry = $_; + if ($entry =~ m/^(\w+)=NaN$/) + { + $ret->{$1} = undef; + } + elsif ($entry =~ m/^(\w+)=($RE{num}{real})$/) + { + $ret->{$1} = 0.0 + $2; + } + } + + return ($ret); +} # getval + +=item I<$obj>-EB (I<%identifier>, B