Merge branch 'collectd-4.0'
[collectd.git] / contrib / PerlLib / Collectd / Unixsock.pm
index b6814f8..3b8a91c 100644 (file)
@@ -76,13 +76,40 @@ sub _create_identifier
 
        $host = $args->{'host'};
        $plugin = $args->{'plugin'};
-       $plugin .= '-' . $args->{'plugin_instance'} if ($args->{'plugin_instance'});
+       $plugin .= '-' . $args->{'plugin_instance'} if (defined ($args->{'plugin_instance'}));
        $type = $args->{'type'};
-       $type .= '-' . $args->{'type_instance'} if ($args->{'type_instance'});
+       $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
@@ -133,10 +160,12 @@ sub getval
        $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)
@@ -148,7 +177,11 @@ sub getval
        for (split (' ', $msg))
        {
                my $entry = $_;
-               if ($entry =~ m/^(\w+)=($RE{num}{real})$/)
+               if ($entry =~ m/^(\w+)=NaN$/)
+               {
+                       $ret->{$1} = undef;
+               }
+               elsif ($entry =~ m/^(\w+)=($RE{num}{real})$/)
                {
                        $ret->{$1} = 0.0 + $2;
                }
@@ -198,9 +231,11 @@ sub putval
        }
 
        $msg = "PUTVAL $identifier $values\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);
        return (1) if ($status == 0);
@@ -209,6 +244,52 @@ sub putval
        return;
 } # putval
 
+=item I<$res> = I<$obj>-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>
+member of each hash holds the epoch value of the last update of that value.
+
+=cut
+
+sub listval
+{
+       my $obj = shift;
+       my $msg;
+       my @ret = ();
+       my $status;
+       my $fh = $obj->{'sock'} or confess;
+
+       $msg = "LISTVAL\n";
+       send ($fh, $msg, 0) or confess ("send: $!");
+
+       $msg = <$fh>;
+       ($status, $msg) = split (' ', $msg, 2);
+       if ($status < 0)
+       {
+               $obj->{'error'} = $msg;
+               return;
+       }
+
+       for (my $i = 0; $i < $status; $i++)
+       {
+               my $time;
+               my $ident;
+
+               $msg = <$fh>;
+               chomp ($msg);
+
+               ($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<$obj>-E<gt>destroy ();
 
 Closes the socket before the object is destroyed. This function is also