projects / collectd.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Merge branch 'collectd-5.4'
[collectd.git] / bindings / perl / lib / Collectd / Unixsock.pm
diff --git a/bindings/perl/lib/Collectd/Unixsock.pm b/bindings/perl/lib/Collectd/Unixsock.pm
index 199a47c..5c6a5f9 100644 (file)
--- a/bindings/perl/lib/Collectd/Unixsock.pm
+++ b/bindings/perl/lib/Collectd/Unixsock.pm
@@ -1,22 +1,27 @@
 #
 #
-# collectd - Collectd::Unixsock
+# collectd - bindings/buildperl/Collectd/Unixsock.pm
 # Copyright (C) 2007,2008  Florian octo Forster
 #
 # Copyright (C) 2007,2008  Florian octo Forster
 #
-# 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.
+# Permission is hereby granted, free of charge, to any person obtaining a
+# copy of this software and associated documentation files (the "Software"),
+# to deal in the Software without restriction, including without limitation
+# the rights to use, copy, modify, merge, publish, distribute, sublicense,
+# and/or sell copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following conditions:
 #
 #
-# 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.
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
 #
 #
-# 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
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+# DEALINGS IN THE SOFTWARE.
 #
 #
-# Author:
-#   Florian octo Forster <octo at verplant.org>
+# Authors:
+#   Florian Forster <octo at collectd.org>
 #
 
 package Collectd::Unixsock;
 #
 
 package Collectd::Unixsock;
@@ -28,7 +33,7 @@ collectd's unixsock plugin.
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
-  use Collectd::Unixsock ();
+  use Collectd::Unixsock;
 
   my $sock = Collectd::Unixsock->new ($path);
 
 
   my $sock = Collectd::Unixsock->new ($path);
 
@@ -51,23 +56,15 @@ programmers to interact with the daemon.
 use strict;
 use warnings;
 
 use strict;
 use warnings;
 
-#use constant { NOTIF_FAILURE => 1, NOTIF_WARNING => 2, NOTIF_OKAY => 4 };
-
-use Carp (qw(cluck confess));
+use Carp qw(cluck confess carp croak);
 use IO::Socket::UNIX;
 use IO::Socket::UNIX;
-use Regexp::Common (qw(number));
+use Scalar::Util qw( looks_like_number );
 
 our $Debug = 0;
 
 
 our $Debug = 0;
 
-return (1);
-
 sub _debug
 {
 sub _debug
 {
-       if (!$Debug)
-       {
-               return;
-       }
-       print @_;
+       print @_ if $Debug;
 }
 
 sub _create_socket
 }
 
 sub _create_socket
@@ -84,88 +81,124 @@ sub _create_socket
 
 =head1 VALUE IDENTIFIERS
 
 
 =head1 VALUE IDENTIFIERS
 
-The values in the collectd are identified using an five-tuple (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<host>, B<plugin>, and
-B<type>, possibly completed by B<plugin_instance> and B<type_instance>.
+The values in the collectd are identified using a five-tuple (host, plugin,
+plugin-instance, type, type-instance) where only plugin instance and type
+instance may be undef. Many functions expect an I<%identifier> hash that has at
+least the members B<host>, B<plugin>, and B<type>, possibly completed by
+B<plugin_instance> and B<type_instance>.
 
 Usually you can pass this hash as follows:
 
 
 Usually you can pass this hash as follows:
 
-  $obj->method (host => $host, plugin => $plugin, type => $type, %other_args);
+  $self->method (host => $host, plugin => $plugin, type => $type, %other_args);
 
 =cut
 
 sub _create_identifier
 {
        my $args = shift;
 
 =cut
 
 sub _create_identifier
 {
        my $args = shift;
-       my $host;
-       my $plugin;
-       my $type;
+       my ($host, $plugin, $type);
 
 
-       if (!$args->{'host'} || !$args->{'plugin'} || !$args->{'type'})
+       if (!$args->{host} || !$args->{plugin} || !$args->{type})
        {
                cluck ("Need `host', `plugin' and `type'");
                return;
        }
 
        {
                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'}));
+       $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");
+       return "$host/$plugin/$type";
 } # _create_identifier
 
 sub _parse_identifier
 {
        my $string = shift;
 } # _create_identifier
 
 sub _parse_identifier
 {
        my $string = shift;
-       my $host;
-       my $plugin;
-       my $plugin_instance;
-       my $type;
-       my $type_instance;
-       my $ident;
+       my ($plugin_instance, $type_instance);
 
 
-       ($host, $plugin, $type) = split ('/', $string);
+       my ($host, $plugin, $type) = split /\//, $string;
 
 
-       ($plugin, $plugin_instance) = split ('-', $plugin, 2);
-       ($type, $type_instance) = split ('-', $type, 2);
+       ($plugin, $plugin_instance) = split /-/, $plugin, 2;
+       ($type, $type_instance) = split /-/, $type, 2;
 
 
-       $ident =
+       my $ident =
        {
                host => $host,
                plugin => $plugin,
                type => $type
        };
        {
                host => $host,
                plugin => $plugin,
                type => $type
        };
-       $ident->{'plugin_instance'} = $plugin_instance if (defined ($plugin_instance));
-       $ident->{'type_instance'} = $type_instance if (defined ($type_instance));
+       $ident->{plugin_instance} = $plugin_instance if defined $plugin_instance;
+       $ident->{type_instance} = $type_instance if defined $type_instance;
 
 
-       return ($ident);
+       return $ident;
 } # _parse_identifier
 
 sub _escape_argument
 {
 } # _parse_identifier
 
 sub _escape_argument
 {
-       my $string = shift;
+       local $_ = shift;
+
+       return $_ if /^\w+$/;
+
+       s#\\#\\\\#g;
+       s#"#\\"#g;
+       return "\"$_\"";
+}
+
+# Send a command on a socket, including any required argument escaping.
+# Return a single line of result.
+sub _socket_command {
+       my ($self, $command, $args) = @_;
+
+       my $fh = $self->{sock} or confess ('object has no filehandle');
+
+    if($args) {
+        my $identifier = _create_identifier ($args) or return;
+           $command .= ' ' . _escape_argument ($identifier) . "\n";
+    } else {
+        $command .= "\n";
+    }
+       _debug "-> $command";
+       $fh->print($command);
+
+       my $response = $fh->getline;
+       chomp $response;
+       _debug "<- $response\n";
+    return $response;
+}
+
+# Read any remaining results from a socket and pass them to
+# a callback for caller-defined mangling.
+sub _socket_chat
+{
+       my ($self, $msg, $callback, $cbdata) = @_;
+       my ($nresults, $ret);
+       my $fh = $self->{sock} or confess ('object has no filehandle');
 
 
-       if ($string =~ m/^\w+$/)
+       ($nresults, $msg) = split / /, $msg, 2;
+       if ($nresults <= 0)
        {
        {
-               return ("$string");
+               $self->{error} = $msg;
+               return;
        }
 
        }
 
-       $string =~ s#\\#\\\\#g;
-       $string =~ s#"#\\"#g;
-       $string = "\"$string\"";
-
-       return ($string);
+       for (1 .. $nresults)
+       {
+               my $entry = $fh->getline;
+               chomp $entry;
+               _debug "<- $entry\n";
+        $callback->($entry, $cbdata);
+       }
+       return $cbdata;
 }
 
 }
 
+
 =head1 PUBLIC METHODS
 
 =over 4
 
 =head1 PUBLIC METHODS
 
 =over 4
 
-=item I<$obj> = Collectd::Unixsock->B<new> ([I<$path>]);
+=item I<$self> = Collectd::Unixsock->B<new> ([I<$path>]);
 
 Creates a new connection to the daemon. The optional I<$path> argument gives
 the path to the UNIX socket of the C<unixsock plugin> and defaults to
 
 Creates a new connection to the daemon. The optional I<$path> argument gives
 the path to the UNIX socket of the C<unixsock plugin> and defaults to
@@ -176,19 +209,18 @@ false on error.
 
 sub new
 {
 
 sub new
 {
-       my $pkg = shift;
-       my $path = @_ ? shift : '/var/run/collectd-unixsock';
+       my $class = shift;
+       my $path = shift || '/var/run/collectd-unixsock';
        my $sock = _create_socket ($path) or return;
        my $sock = _create_socket ($path) or return;
-       my $obj = bless (
+       return bless
                {
                        path => $path,
                        sock => $sock,
                        error => 'No error'
                {
                        path => $path,
                        sock => $sock,
                        error => 'No error'
-               }, $pkg);
-       return ($obj);
+               }, $class;
 } # new
 
 } # new
 
-=item I<$res> = I<$obj>-E<gt>B<getval> (I<%identifier>);
+=item I<$res> = I<$self>-E<gt>B<getval> (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
 
 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
@@ -198,53 +230,22 @@ value. On error false is returned.
 
 sub getval # {{{
 {
 
 sub getval # {{{
 {
-       my $obj = shift;
+       my $self = shift;
        my %args = @_;
        my %args = @_;
-
-       my $status;
-       my $fh = $obj->{'sock'} or confess ('object has no filehandle');
-       my $msg;
-       my $identifier;
-
        my $ret = {};
 
        my $ret = {};
 
-       $identifier = _create_identifier (\%args) or return;
-
-       $msg = 'GETVAL ' . _escape_argument ($identifier) . "\n";
-       _debug "-> $msg";
-       print $fh $msg;
-
-       $msg = <$fh>;
-       chomp ($msg);
-       _debug "<- $msg\n";
-
-       ($status, $msg) = split (' ', $msg, 2);
-       if ($status <= 0)
-       {
-               $obj->{'error'} = $msg;
-               return;
-       }
-
-       for (my $i = 0; $i < $status; $i++)
-       {
-               my $entry = <$fh>;
-               chomp ($entry);
-               _debug "<- $entry\n";
-
-               if ($entry =~ m/^(\w+)=NaN$/)
-               {
-                       $ret->{$1} = undef;
-               }
-               elsif ($entry =~ m/^(\w+)=($RE{num}{real})$/)
-               {
-                       $ret->{$1} = 0.0 + $2;
-               }
-       }
-
-       return ($ret);
+    my $msg = $self->_socket_command('GETVAL', \%args) or return;
+    $self->_socket_chat($msg, sub {
+            local $_ = shift;
+            my $ret = shift;
+            /^(\w+)=NaN$/ and $ret->{$1} = undef, return;
+            /^(\w+)=(.*)$/ and looks_like_number($2) and $ret->{$1} = 0 + $2, return;
+        }, $ret
+    );
+       return $ret;
 } # }}} sub getval
 
 } # }}} sub getval
 
-=item I<$res> = I<$obj>-E<gt>B<getthreshold> (I<%identifier>);
+=item I<$res> = I<$self>-E<gt>B<getthreshold> (I<%identifier>);
 
 Requests a threshold from the daemon. On success a hash-ref is returned with
 the threshold data. On error false is returned.
 
 Requests a threshold from the daemon. On success a hash-ref is returned with
 the threshold data. On error false is returned.
@@ -253,55 +254,24 @@ the threshold data. On error false is returned.
 
 sub getthreshold # {{{
 {
 
 sub getthreshold # {{{
 {
-       my $obj = shift;
+       my $self = shift;
        my %args = @_;
        my %args = @_;
-
-       my $status;
-       my $fh = $obj->{'sock'} or confess ('object has no filehandle');
-       my $msg;
-       my $identifier;
-
        my $ret = {};
 
        my $ret = {};
 
-       $identifier = _create_identifier (\%args) or return;
-
-       $msg = 'GETTHRESHOLD ' . _escape_argument ($identifier) . "\n";
-       _debug "-> $msg";
-       print $fh $msg;
-
-       $msg = <$fh>;
-       chomp ($msg);
-       _debug "<- $msg\n";
-
-       ($status, $msg) = split (' ', $msg, 2);
-       if ($status <= 0)
-       {
-               $obj->{'error'} = $msg;
-               return;
-       }
-
-       for (my $i = 0; $i < $status; $i++)
-       {
-               my $entry = <$fh>;
-               chomp ($entry);
-               _debug "<- $entry\n";
-
-               if ($entry =~ m/^([^:]+):\s*(\S.*)$/)
-               {
-                       my $key = $1;
-                       my $value = $2;
-
-                       $key =~ s/^\s+//;
-                       $key =~ s/\s+$//;
-
-                       $ret->{$key} = $value;
-               }
-       }
-
-       return ($ret);
+    my $msg = $self->_socket_command('GETTHRESHOLD', \%args) or return;
+    $self->_socket_chat($msg, sub {
+            local $_ = shift;
+            my $ret = shift;
+                   /^\s*([^:]+):\s*(.*)/ and do {
+                           $1 =~ s/\s*$//;
+                           $ret->{$1} = $2;
+                   };
+        }, $ret
+    );
+       return $ret;
 } # }}} sub getthreshold
 
 } # }}} sub getthreshold
 
-=item I<$obj>-E<gt>B<putval> (I<%identifier>, B<time> =E<gt> I<$time>, B<values> =E<gt> [...]);
+=item I<$self>-E<gt>B<putval> (I<%identifier>, B<time> =E<gt> I<$time>, B<values> =E<gt> [...]);
 
 Submits a value-list to the daemon. If the B<time> argument is omitted
 C<time()> is used. The required argument B<values> is a reference to an array
 
 Submits a value-list to the daemon. If the B<time> argument is omitted
 C<time()> is used. The required argument B<values> is a reference to an array
@@ -315,51 +285,44 @@ otherwise.
 
 sub putval
 {
 
 sub putval
 {
-       my $obj = shift;
+       my $self = shift;
        my %args = @_;
 
        my %args = @_;
 
-       my $status;
-       my $fh = $obj->{'sock'} or confess;
-       my $msg;
-       my $identifier;
-       my $values;
-       my $interval = "";
+       my ($status, $msg, $identifier, $values);
+       my $fh = $self->{sock} or confess;
 
 
-       if (defined $args{'interval'})
-       {
-               $interval = ' interval='
-               . _escape_argument ($args{'interval'});
-       }
+       my $interval = defined $args{interval} ?
+    ' interval=' . _escape_argument ($args{interval}) : '';
 
        $identifier = _create_identifier (\%args) or return;
 
        $identifier = _create_identifier (\%args) or return;
-       if (!$args{'values'})
+       if (!$args{values})
        {
                cluck ("Need argument `values'");
                return;
        }
 
        {
                cluck ("Need argument `values'");
                return;
        }
 
-       if (!ref ($args{'values'}))
-       {
-               $values = $args{'values'};
-       }
-       else
+       if (ref ($args{values}))
        {
                my $time;
 
        {
                my $time;
 
-               if ("ARRAY" ne ref ($args{'values'}))
+               if ("ARRAY" ne ref ($args{values}))
                {
                        cluck ("Invalid `values' argument (expected an array ref)");
                        return;
                }
 
                {
                        cluck ("Invalid `values' argument (expected an array ref)");
                        return;
                }
 
-               if (! scalar @{$args{'values'}})
+               if (! scalar @{$args{values}})
                {
                        cluck ("Empty `values' array");
                        return;
                }
 
                {
                        cluck ("Empty `values' array");
                        return;
                }
 
-               $time = $args{'time'} ? $args{'time'} : time ();
-               $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
+               $time = $args{time} || time;
+               $values = join (':', $time, map { defined $_ ? $_ : 'U' } @{$args{values}});
+       }
+       else
+       {
+               $values = $args{values};
        }
 
        $msg = 'PUTVAL '
        }
 
        $msg = 'PUTVAL '
@@ -367,20 +330,72 @@ sub putval
        . $interval
        . ' ' . _escape_argument ($values) . "\n";
        _debug "-> $msg";
        . $interval
        . ' ' . _escape_argument ($values) . "\n";
        _debug "-> $msg";
-       print $fh $msg;
+       $fh->print($msg);
 
        $msg = <$fh>;
 
        $msg = <$fh>;
-       chomp ($msg);
+       chomp $msg;
        _debug "<- $msg\n";
 
        _debug "<- $msg\n";
 
-       ($status, $msg) = split (' ', $msg, 2);
-       return (1) if ($status == 0);
+       ($status, $msg) = split / /, $msg, 2;
+       return 1 if $status == 0;
 
 
-       $obj->{'error'} = $msg;
+       $self->{error} = $msg;
        return;
 } # putval
 
        return;
 } # putval
 
-=item I<$res> = I<$obj>-E<gt>B<listval> ()
+=item I<$res> = I<$self>-E<gt>B<listval_filter> ( C<%identifier> )
+
+Queries a list of values from the daemon while restricting the results to
+certain hosts, plugins etc. The argument may be anything that passes for an
+identifier (cf. L<VALUE IDENTIFIERS>), although all fields are optional.
+The returned data is in the same format as from C<listval>.
+
+=cut
+
+sub listval_filter
+{
+       my $self = shift;
+    my %args = @_;
+       my @ret;
+       my $nresults;
+       my $fh = $self->{sock} or confess;
+
+    my $pattern =
+    (exists $args{host}              ? "$args{host}"             : '[^/]+') .
+    (exists $args{plugin}            ? "/$args{plugin}"          : '/[^/-]+') .
+       (exists $args{plugin_instance}   ? "-$args{plugin_instance}" : '(?:-[^/]+)?') .
+       (exists $args{type}              ? "/$args{type}"            : '/[^/-]+') .
+       (exists $args{type_instance}     ? "-$args{type_instance}"   : '(?:-[^/]+)?');
+    $pattern = qr/^\d+ $pattern$/;
+
+    my $msg = $self->_socket_command('LISTVAL') or return;
+       ($nresults, $msg) = split / /, $msg, 2;
+
+    # This could use _socket_chat() but doesn't for speed reasons
+       if ($nresults < 0)
+       {
+               $self->{error} = $msg;
+               return;
+       }
+
+       for (1 .. $nresults)
+       {
+               $msg = <$fh>;
+               chomp $msg;
+               _debug "<- $msg\n";
+               next unless $msg =~ $pattern;
+               my ($time, $ident) = split / /, $msg, 2;
+
+               $ident = _parse_identifier ($ident);
+               $ident->{time} = int $time;
+
+               push (@ret, $ident);
+       } # for (i = 0 .. $status)
+
+       return @ret;
+} # listval
+
+=item I<$res> = I<$self>-E<gt>B<listval> ()
 
 Queries a list of values from the daemon. The list is returned as an array of
 hash references, where each hash reference is a valid identifier. The C<time>
 
 Queries a list of values from the daemon. The list is returned as an array of
 hash references, where each hash reference is a valid identifier. The C<time>
@@ -390,46 +405,39 @@ member of each hash holds the epoch value of the last update of that value.
 
 sub listval
 {
 
 sub listval
 {
-       my $obj = shift;
-       my $msg;
-       my @ret = ();
-       my $status;
-       my $fh = $obj->{'sock'} or confess;
+       my $self = shift;
+       my $nresults;
+       my @ret;
+       my $fh = $self->{sock} or confess;
 
 
-       _debug "LISTVAL\n";
-       print $fh "LISTVAL\n";
+    my $msg = $self->_socket_command('LISTVAL') or return;
+       ($nresults, $msg) = split / /, $msg, 2;
 
 
-       $msg = <$fh>;
-       chomp ($msg);
-       _debug "<- $msg\n";
-       ($status, $msg) = split (' ', $msg, 2);
-       if ($status < 0)
+    # This could use _socket_chat() but doesn't for speed reasons
+       if ($nresults < 0)
        {
        {
-               $obj->{'error'} = $msg;
+               $self->{error} = $msg;
                return;
        }
 
                return;
        }
 
-       for (my $i = 0; $i < $status; $i++)
+       for (1 .. $nresults)
        {
        {
-               my $time;
-               my $ident;
-
                $msg = <$fh>;
                $msg = <$fh>;
-               chomp ($msg);
+               chomp $msg;
                _debug "<- $msg\n";
 
                _debug "<- $msg\n";
 
-               ($time, $ident) = split (' ', $msg, 2);
+               my ($time, $ident) = split / /, $msg, 2;
 
                $ident = _parse_identifier ($ident);
 
                $ident = _parse_identifier ($ident);
-               $ident->{'time'} = int ($time);
+               $ident->{time} = int $time;
 
                push (@ret, $ident);
        } # for (i = 0 .. $status)
 
 
                push (@ret, $ident);
        } # for (i = 0 .. $status)
 
-       return (@ret);
+       return @ret;
 } # listval
 
 } # listval
 
-=item I<$res> = I<$obj>-E<gt>B<putnotif> (B<severity> =E<gt> I<$severity>, B<message> =E<gt> I<$message>, ...);
+=item I<$res> = I<$self>-E<gt>B<putnotif> (B<severity> =E<gt> I<$severity>, B<message> =E<gt> I<$message>, ...);
 
 Submits a notification to the daemon.
 
 
 Submits a notification to the daemon.
 
@@ -464,57 +472,48 @@ For more details, please see L<collectd-unixsock(5)>.
 
 sub putnotif
 {
 
 sub putnotif
 {
-       my $obj = shift;
+       my $self = shift;
        my %args = @_;
 
        my $status;
        my %args = @_;
 
        my $status;
-       my $fh = $obj->{'sock'} or confess;
+       my $fh = $self->{sock} or confess;
 
        my $msg; # message sent to the socket
        
 
        my $msg; # message sent to the socket
        
-       if (!$args{'message'})
-       {
-               cluck ("Need argument `message'");
-               return;
-       }
-       if (!$args{'severity'})
-       {
-               cluck ("Need argument `severity'");
-               return;
-       }
-       $args{'severity'} = lc ($args{'severity'});
-       if (($args{'severity'} ne 'failure')
-               && ($args{'severity'} ne 'warning')
-               && ($args{'severity'} ne 'okay'))
+    for my $arg (qw( message severity ))
+    {
+        cluck ("Need argument `$arg'"), return unless $args{$arg};
+    }
+       $args{severity} = lc $args{severity};
+       if (($args{severity} ne 'failure')
+               && ($args{severity} ne 'warning')
+               && ($args{severity} ne 'okay'))
        {
        {
-               cluck ("Invalid `severity: " . $args{'severity'});
+               cluck ("Invalid `severity: " . $args{severity});
                return;
        }
 
                return;
        }
 
-       if (!$args{'time'})
-       {
-               $args{'time'} = time ();
-       }
+       $args{time} ||= time;
        
        $msg = 'PUTNOTIF '
        
        $msg = 'PUTNOTIF '
-       . join (' ', map { $_ . '=' . _escape_argument ($args{$_}) } (keys %args))
+       . join (' ', map { $_ . '=' . _escape_argument ($args{$_}) } keys %args)
        . "\n";
 
        _debug "-> $msg";
        . "\n";
 
        _debug "-> $msg";
-       print $fh $msg;
+       $fh->print($msg);
 
        $msg = <$fh>;
 
        $msg = <$fh>;
-       chomp ($msg);
+       chomp $msg;
        _debug "<- $msg\n";
 
        _debug "<- $msg\n";
 
-       ($status, $msg) = split (' ', $msg, 2);
-       return (1) if ($status == 0);
+       ($status, $msg) = split / /, $msg, 2;
+       return 1 if $status == 0;
 
 
-       $obj->{'error'} = $msg;
+       $self->{error} = $msg;
        return;
 } # putnotif
 
        return;
 } # putnotif
 
-=item I<$obj>-E<gt>B<flush> (B<timeout> =E<gt> I<$timeout>, B<plugins> =E<gt> [...], B<identifier>  =E<gt> [...]);
+=item I<$self>-E<gt>B<flush> (B<timeout> =E<gt> I<$timeout>, B<plugins> =E<gt> [...], B<identifier>  =E<gt> [...]);
 
 Flush cached data.
 
 
 Flush cached data.
 
@@ -544,48 +543,38 @@ are hash references and have the members as outlined in L<VALUE IDENTIFIERS>.
 
 sub flush
 {
 
 sub flush
 {
-       my $obj  = shift;
+       my $self  = shift;
        my %args = @_;
 
        my %args = @_;
 
-       my $fh = $obj->{'sock'} or confess;
+       my $fh = $self->{sock} or confess;
 
        my $status = 0;
        my $msg    = "FLUSH";
 
 
        my $status = 0;
        my $msg    = "FLUSH";
 
-       if (defined ($args{'timeout'}))
-       {
-               $msg .= " timeout=" . $args{'timeout'};
-       }
+    $msg .= " timeout=$args{timeout}" if defined $args{timeout};
 
 
-       if ($args{'plugins'})
+       if ($args{plugins})
        {
        {
-               foreach my $plugin (@{$args{'plugins'}})
+               foreach my $plugin (@{$args{plugins}})
                {
                        $msg .= " plugin=" . $plugin;
                }
        }
 
                {
                        $msg .= " plugin=" . $plugin;
                }
        }
 
-       if ($args{'identifier'})
+       if ($args{identifier})
        {
        {
-               for (@{$args{'identifier'}})
+               for my $identifier (@{$args{identifier}})
                {
                {
-                       my $identifier = $_;
                        my $ident_str;
 
                        if (ref ($identifier) ne 'HASH')
                        {
                                cluck ("The argument of the `identifier' "
                        my $ident_str;
 
                        if (ref ($identifier) ne 'HASH')
                        {
                                cluck ("The argument of the `identifier' "
-                                       . "option must be an array reference "
-                                       . "of hash references.");
-                               return;
-                       }
-
-                       $ident_str = _create_identifier ($identifier);
-                       if (!$ident_str)
-                       {
+                                       . "option must be an array of hashrefs.");
                                return;
                        }
 
                                return;
                        }
 
+                       $ident_str = _create_identifier ($identifier) or return;
                        $msg .= ' identifier=' . _escape_argument ($ident_str);
                }
        }
                        $msg .= ' identifier=' . _escape_argument ($ident_str);
                }
        }
@@ -593,30 +582,25 @@ sub flush
        $msg .= "\n";
 
        _debug "-> $msg";
        $msg .= "\n";
 
        _debug "-> $msg";
-       print $fh $msg;
+       $fh->print($msg);
 
        $msg = <$fh>;
        chomp ($msg);
        _debug "<- $msg\n";
 
 
        $msg = <$fh>;
        chomp ($msg);
        _debug "<- $msg\n";
 
-       ($status, $msg) = split (' ', $msg, 2);
-       return (1) if ($status == 0);
+       ($status, $msg) = split / /, $msg, 2;
+       return 1 if $status == 0;
 
 
-       $obj->{'error'} = $msg;
+       $self->{error} = $msg;
        return;
 }
 
 sub error
 {
        return;
 }
 
 sub error
 {
-       my $obj = shift;
-       if ($obj->{'error'})
-       {
-               return ($obj->{'error'});
-       }
-       return;
+       return shift->{error};
 }
 
 }
 
-=item I<$obj>-E<gt>destroy ();
+=item I<$self>-E<gt>destroy ();
 
 Closes the socket before the object is destroyed. This function is also
 automatically called then the object goes out of scope.
 
 Closes the socket before the object is destroyed. This function is also
 automatically called then the object goes out of scope.
@@ -627,18 +611,18 @@ automatically called then the object goes out of scope.
 
 sub destroy
 {
 
 sub destroy
 {
-       my $obj = shift;
-       if ($obj->{'sock'})
+       my $self = shift;
+       if ($self->{sock})
        {
        {
-               close ($obj->{'sock'});
-               delete ($obj->{'sock'});
+               close $self->{sock};
+               delete $self->{sock};
        }
 }
 
 sub DESTROY
 {
        }
 }
 
 sub DESTROY
 {
-       my $obj = shift;
-       $obj->destroy ();
+       my $self = shift;
+       $self->destroy ();
 }
 
 =head1 SEE ALSO
 }
 
 =head1 SEE ALSO
@@ -649,8 +633,8 @@ L<collectd-unixsock(5)>
 
 =head1 AUTHOR
 
 
 =head1 AUTHOR
 
-Florian octo Forster E<lt>octo@verplant.orgE<gt>
+Florian octo Forster E<lt>octo@collectd.orgE<gt>
 
 =cut
 
 =cut
-
+1;
 # vim: set fdm=marker :
 # vim: set fdm=marker :
collectd, the system statistics collection daemon