X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=bindings%2Fperl%2FCollectd%2FUnixsock.pm;h=cd910ed080e73d1779b2787f3d1230825c5b797c;hb=b4d9bd23f3e04f9b42204d9954842524e2a7eb61;hp=d3b77d02e4d714f5fbf6ad24022f7c7dd6700705;hpb=d5272dbabf4c7a47f34066c05f479523d7b8beae;p=collectd.git

diff --git a/bindings/perl/Collectd/Unixsock.pm b/bindings/perl/Collectd/Unixsock.pm
index d3b77d02..cd910ed0 100644
--- a/bindings/perl/Collectd/Unixsock.pm
+++ b/bindings/perl/Collectd/Unixsock.pm
@@ -71,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
@@ -217,10 +217,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.
 
@@ -236,6 +236,12 @@ sub putval
 	my $msg;
 	my $identifier;
 	my $values;
+	my $interval = "";
+
+	if (defined $args{'interval'})
+	{
+		$interval = ' interval=' . $args{'interval'};
+	}
 
 	$identifier = _create_identifier (\%args) or return;
 	if (!$args{'values'})
@@ -254,7 +260,7 @@ sub putval
 		$values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
 	}
 
-	$msg = "PUTVAL $identifier $values\n";
+	$msg = "PUTVAL $identifier$interval $values\n";
 	#print "-> $msg";
 	send ($fh, $msg, 0) or confess ("send: $!");
 	$msg = undef;
@@ -400,6 +406,101 @@ 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;
+			}
+			if ($ident_str =~ m/ /)
+			{
+				$ident_str =~ s#\\#\\\\#g;
+				$ident_str =~ s#"#\\"#g;
+				$ident_str = "\"$ident_str\"";
+			}
+
+			$msg .= " identifier=$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