src/utils_cmd_putval.[ch]: Allow identifiers to include spaces.

[collectd.git] / bindings / perl / Collectd / Unixsock.pm

diff --git a/bindings/perl/Collectd/Unixsock.pm b/bindings/perl/Collectd/Unixsock.pm
index d3b77d0..c136221 100644 (file)
--- a/bindings/perl/Collectd/Unixsock.pm
+++ b/bindings/perl/Collectd/Unixsock.pm
@@ -71,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


@@ -134,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


@@ -175,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;
 


@@ -183,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: $!");
 


@@ -217,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
 =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 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.
 


@@ -236,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'})


@@ -254,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;


@@ -400,6 +426,95 @@ sub putnotif
        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> [...]);
+
+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