src/utils_cmd_putval.[ch]: Allow identifiers to include spaces.
[collectd.git] / bindings / perl / Collectd / Unixsock.pm
index 3b8a91c..c136221 100644 (file)
@@ -1,8 +1,30 @@
+#
+# collectd - Collectd::Unixsock
+# 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.
+#
+# 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:
+#   Florian octo Forster <octo at verplant.org>
+#
+
 package Collectd::Unixsock;
 
 =head1 NAME
 
 package Collectd::Unixsock;
 
 =head1 NAME
 
-Collectd::Unixsock - Abstraction layer for accessing the functionality by collectd's unixsock plugin.
+Collectd::Unixsock - Abstraction layer for accessing the functionality by
+collectd's unixsock plugin.
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 
@@ -29,6 +51,8 @@ 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 IO::Socket::UNIX;
 use Regexp::Common (qw(number));
 use Carp (qw(cluck confess));
 use IO::Socket::UNIX;
 use Regexp::Common (qw(number));
@@ -47,9 +71,9 @@ sub _create_socket
        return ($sock);
 } # _create_socket
 
        return ($sock);
 } # _create_socket
 
-=head1 VALUE IDENTIFIER
+=head1 VALUE IDENTIFIERS
 
 
-The values in the collectd are identified using an five-tupel (host, plugin,
+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
 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
@@ -110,6 +134,22 @@ sub _parse_identifier
        return ($ident);
 } # _parse_identifier
 
        return ($ident);
 } # _parse_identifier
 
+sub _escape_argument
+{
+       my $string = shift;
+
+       if ($string =~ m/^\w+$/)
+       {
+               return ("$string");
+       }
+
+       $string =~ s#\\#\\\\#g;
+       $string =~ s#"#\\"#g;
+       $string = "\"$string\"";
+
+       return ($string);
+}
+
 =head1 PUBLIC METHODS
 
 =over 4
 =head1 PUBLIC METHODS
 
 =over 4
@@ -151,7 +191,7 @@ sub getval
        my %args = @_;
 
        my $status;
        my %args = @_;
 
        my $status;
-       my $fh = $obj->{'sock'} or confess;
+       my $fh = $obj->{'sock'} or confess ('object has no filehandle');
        my $msg;
        my $identifier;
 
        my $msg;
        my $identifier;
 
@@ -159,7 +199,7 @@ sub getval
 
        $identifier = _create_identifier (\%args) or return;
 
 
        $identifier = _create_identifier (\%args) or return;
 
-       $msg = "GETVAL $identifier\n";
+       $msg = 'GETVAL ' . _escape_argument ($identifier) . "\n";
        #print "-> $msg";
        send ($fh, $msg, 0) or confess ("send: $!");
 
        #print "-> $msg";
        send ($fh, $msg, 0) or confess ("send: $!");
 
@@ -190,13 +230,13 @@ sub getval
        return ($ret);
 } # getval
 
        return ($ret);
 } # getval
 
-=item I<$obj>-E<gt>B<putval> (I<%identifier>, B<time> => I<$time>, B<values> => [...]);
+=item I<$obj>-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
 
 Submits a value-list to the daemon. If the B<time> argument is omitted
-C<time()> is used. The requierd argument B<values> is a reference to an array
+C<time()> is used. The required argument B<values> is a reference to an array
 of values that is to be submitted. The number of values must match the number
 of values that is to be submitted. The number of values must match the number
-of values expected for the given B<type> (see L<VALUE IDENTIFIER>), though this
-is checked by the daemon, not the Perl module. Also, gauge data-sources
+of values expected for the given B<type> (see L<VALUE IDENTIFIERS>), though
+this is checked by the daemon, not the Perl module. Also, gauge data-sources
 (e.E<nbsp>g. system-load) may be C<undef>. Returns true upon success and false
 otherwise.
 
 (e.E<nbsp>g. system-load) may be C<undef>. Returns true upon success and false
 otherwise.
 
@@ -212,6 +252,13 @@ sub putval
        my $msg;
        my $identifier;
        my $values;
        my $msg;
        my $identifier;
        my $values;
+       my $interval = "";
+
+       if (defined $args{'interval'})
+       {
+               $interval = ' interval='
+               . _escape_argument ($args{'interval'});
+       }
 
        $identifier = _create_identifier (\%args) or return;
        if (!$args{'values'})
 
        $identifier = _create_identifier (\%args) or return;
        if (!$args{'values'})
@@ -230,7 +277,10 @@ sub putval
                $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
        }
 
                $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
        }
 
-       $msg = "PUTVAL $identifier $values\n";
+       $msg = 'PUTVAL '
+       . _escape_argument ($identifier)
+       . $interval
+       . ' ' . _escape_argument ($values) . "\n";
        #print "-> $msg";
        send ($fh, $msg, 0) or confess ("send: $!");
        $msg = undef;
        #print "-> $msg";
        send ($fh, $msg, 0) or confess ("send: $!");
        $msg = undef;
@@ -290,6 +340,181 @@ sub listval
        return (@ret);
 } # listval
 
        return (@ret);
 } # listval
 
+=item I<$res> = I<$obj>-E<gt>B<putnotif> (B<severity> =E<gt> I<$severity>, B<message> =E<gt> I<$message>, ...);
+
+Submits a notification to the daemon.
+
+Valid options are:
+
+=over 4
+
+=item B<severity>
+
+Sets the severity of the notification. The value must be one of the following
+strings: C<failure>, C<warning>, or C<okay>. Case does not matter. This option
+is mandatory.
+
+=item B<message>
+
+Sets the message of the notification. This option is mandatory.
+
+=item B<time>
+
+Sets the time. If omitted, C<time()> is used.
+
+=item I<Value identifier>
+
+All the other fields of the value identifiers, B<host>, B<plugin>,
+B<plugin_instance>, B<type>, and B<type_instance>, are optional. When given,
+the notification is associated with the performance data of that identifier.
+For more details, please see L<collectd-unixsock(5)>.
+
+=back
+
+=cut
+
+sub putnotif
+{
+       my $obj = shift;
+       my %args = @_;
+
+       my $status;
+       my $fh = $obj->{'sock'} or confess;
+
+       my $msg; # message sent to the socket
+       my $opt_msg; # message of the notification
+       
+       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'))
+       {
+               cluck ("Invalid `severity: " . $args{'severity'});
+               return;
+       }
+
+       if (!$args{'time'})
+       {
+               $args{'time'} = time ();
+       }
+       
+       $opt_msg = $args{'message'};
+       delete ($args{'message'});
+
+       $msg = 'PUTNOTIF '
+       . join (' ', map { $_ . '=' . $args{$_} } (keys %args))
+       . " message=$opt_msg\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;
+} # putnotif
+
+=item I<$obj>-E<gt>B<flush> (B<timeout> =E<gt> I<$timeout>, B<plugins> =E<gt> [...], B<identifier>  =E<gt> [...]);
+
+Flush cached data.
+
+Valid options are:
+
+=over 4
+
+=item B<timeout>
+
+If this option is specified, only data older than I<$timeout> seconds is
+flushed.
+
+=item B<plugins>
+
+If this option is specified, only the selected plugins will be flushed. The
+argument is a reference to an array of strings.
+
+=item B<identifier>
+
+If this option is specified, only the given identifier(s) will be flushed. The
+argument is a reference to an array of identifiers. Identifiers, in this case,
+are hash references and have the members as outlined in L<VALUE IDENTIFIERS>.
+
+=back
+
+=cut
+
+sub flush
+{
+       my $obj  = shift;
+       my %args = @_;
+
+       my $fh = $obj->{'sock'} or confess;
+
+       my $status = 0;
+       my $msg    = "FLUSH";
+
+       if (defined ($args{'timeout'}))
+       {
+               $msg .= " timeout=" . $args{'timeout'};
+       }
+
+       if ($args{'plugins'})
+       {
+               foreach my $plugin (@{$args{'plugins'}})
+               {
+                       $msg .= " plugin=" . $plugin;
+               }
+       }
+
+       if ($args{'identifier'})
+       {
+               for (@{$args{'identifier'}})
+               {
+                       my $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)
+                       {
+                               return;
+                       }
+
+                       $msg .= ' identifier=' . _escape_argument ($ident_str);
+               }
+       }
+
+       $msg .= "\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;
+}
+
 =item I<$obj>-E<gt>destroy ();
 
 Closes the socket before the object is destroyed. This function is also
 =item I<$obj>-E<gt>destroy ();
 
 Closes the socket before the object is destroyed. This function is also
@@ -315,6 +540,12 @@ sub DESTROY
        $obj->destroy ();
 }
 
        $obj->destroy ();
 }
 
+=head1 SEE ALSO
+
+L<collectd(1)>,
+L<collectd.conf(5)>,
+L<collectd-unixsock(5)>
+
 =head1 AUTHOR
 
 Florian octo Forster E<lt>octo@verplant.orgE<gt>
 =head1 AUTHOR
 
 Florian octo Forster E<lt>octo@verplant.orgE<gt>