From baf396c9088643cfd6578edc5c6fb3012750c685 Mon Sep 17 00:00:00 2001
From: Matthias Bethke <matthias.bethke@financial.com>
Date: Wed, 10 Sep 2014 19:34:50 +0200
Subject: [PATCH] add listval_filter method and corresponding tests

Rationale:
A frequent use case for LISTVAL is to retrieve a list of resources for a certain
host or host group that is not known in advance, such as when the hosts have
different disks installed. Using the existing listval() method,
Collectd::Unixsock retrieves the entire list, parses each entry into a hash and
returns the list, only to have the caller throw away the vast majority of
entries immediately. listval_filter() allows the caller to pass any attribute
that can be passed to getval() and filters the list of resources retrieved from
the socket before parsing it, resulting in a large speedup.
The current implemntation has some code duplication, although listval() could be
implemented as a small wrapper around listval_filter() with just a few percent
speed penalty due to the extra dynamically built regexp.
---
 bindings/perl/lib/Collectd/Unixsock.pm | 52 ++++++++++++++++++++++++++++++++++
 bindings/perl/t/01_methods.t           | 34 ++++++++++++++++------
 2 files changed, 77 insertions(+), 9 deletions(-)

diff --git a/bindings/perl/lib/Collectd/Unixsock.pm b/bindings/perl/lib/Collectd/Unixsock.pm
index f2e4fb07..5c6a5f9d 100644
--- a/bindings/perl/lib/Collectd/Unixsock.pm
+++ b/bindings/perl/lib/Collectd/Unixsock.pm
@@ -343,6 +343,58 @@ sub putval
 	return;
 } # putval
 
+=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
diff --git a/bindings/perl/t/01_methods.t b/bindings/perl/t/01_methods.t
index 10289c70..2f7818b1 100644
--- a/bindings/perl/t/01_methods.t
+++ b/bindings/perl/t/01_methods.t
@@ -2,13 +2,24 @@
 
 use strict;
 use warnings;
-use Test::More tests => 12;
+use Test::More tests => 14;
 use Collectd::Unixsock;
 use Collectd::MockDaemon;
 
 my $path = mockd_start();
 END { mockd_stop(); }
 
+sub filter_time { return map { delete $_->{time}; $_ } @_ }
+
+sub test_query {
+    my ($s, $attr, $results) = @_;
+    my ($nresults, $resultdata) = @$results;
+    my $r = $s->getval(%{Collectd::Unixsock::_parse_identifier($attr)});
+    is(ref $r, 'HASH', "Got a result for $attr");
+    is(scalar keys $r, $nresults, "$nresults result result for $attr");
+    is_deeply($r, $resultdata, "Data or $attr matches");
+}
+
 my $s = Collectd::Unixsock->new($path);
 isnt($s, undef, "Collectd::Unixsock object created");
 
@@ -30,14 +41,19 @@ is_deeply($values[1234], {
         type => 'cpu',
         host => 'h2gdf6120'
     }, "Correct data returned for select element");
+@values = ();
+
+is_deeply([ filter_time $s->listval_filter() ] , [ filter_time $s->listval ], "listval_filter() w/o filter equivalent to listval()");
+is_deeply(
+    [ filter_time $s->listval_filter(host => 'a1d8f6310', plugin => 'disk', plugin_instance => 'vda6') ],
+    [
+        { 'plugin_instance' => 'vda6', 'type' => 'disk_merged', 'plugin' => 'disk', 'host' => 'a1d8f6310' },
+        { 'host' => 'a1d8f6310', 'plugin' => 'disk', 'plugin_instance' => 'vda6', 'type' => 'disk_octets' },
+        { 'type' => 'disk_ops', 'plugin_instance' => 'vda6', 'plugin' => 'disk', 'host' => 'a1d8f6310' },
+        { 'plugin' => 'disk', 'host' => 'a1d8f6310', 'type' => 'disk_time', 'plugin_instance' => 'vda6' }
+    ],
+    "Correct result from listval_filter on <host>, <plugin> and <plugin_instance>"
+);
 
 # TODO more test for putval() and the like
 
-sub test_query {
-    my ($s, $attr, $results) = @_;
-    my ($nresults, $resultdata) = @$results;
-    my $r = $s->getval(%{Collectd::Unixsock::_parse_identifier($attr)});
-    is(ref $r, 'HASH', "Got a result for $attr");
-    is(scalar keys $r, $nresults, "$nresults result result for $attr");
-    is_deeply($r, $resultdata, "Data or $attr matches");
-}
-- 
2.11.0