src/utils_cmd_putval.[ch]: Allow identifiers to include spaces.
[collectd.git] / bindings / perl / Collectd / Unixsock.pm
index d40f533..c136221 100644 (file)
@@ -1,3 +1,24 @@
+#
+# 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
@@ -50,9 +71,9 @@ sub _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
@@ -113,6 +134,22 @@ sub _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
@@ -154,7 +191,7 @@ sub getval
        my %args = @_;
 
        my $status;
-       my $fh = $obj->{'sock'} or confess;
+       my $fh = $obj->{'sock'} or confess ('object has no filehandle');
        my $msg;
        my $identifier;
 
@@ -162,7 +199,7 @@ sub getval
 
        $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: $!");
 
@@ -196,10 +233,10 @@ sub getval
 =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
-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 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.
 
@@ -215,6 +252,13 @@ sub putval
        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'})
@@ -233,7 +277,10 @@ sub putval
                $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;
@@ -379,6 +426,95 @@ sub putnotif
        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