use IO::Socket::UNIX;
use Regexp::Common (qw(number));
+our $Debug = 0;
+
return (1);
+sub _debug
+{
+ if (!$Debug)
+ {
+ return;
+ }
+ print @_;
+}
+
sub _create_socket
{
my $path = shift;
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
=cut
-sub getval
+sub getval # {{{
{
my $obj = shift;
my %args = @_;
my $status;
- my $fh = $obj->{'sock'} or confess;
+ my $fh = $obj->{'sock'} or confess ('object has no filehandle');
my $msg;
my $identifier;
$identifier = _create_identifier (\%args) or return;
- $msg = "GETVAL $identifier\n";
- #print "-> $msg";
- send ($fh, $msg, 0) or confess ("send: $!");
+ $msg = 'GETVAL ' . _escape_argument ($identifier) . "\n";
+ _debug "-> $msg";
+ print $fh $msg;
- $msg = undef;
- recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
- #print "<- $msg";
+ $msg = <$fh>;
+ chomp ($msg);
+ _debug "<- $msg\n";
($status, $msg) = split (' ', $msg, 2);
if ($status <= 0)
return;
}
- for (split (' ', $msg))
+ for (my $i = 0; $i < $status; $i++)
{
- my $entry = $_;
+ my $entry = <$fh>;
+ chomp ($entry);
+ _debug "<- $entry\n";
+
if ($entry =~ m/^(\w+)=NaN$/)
{
$ret->{$1} = undef;
}
return ($ret);
-} # getval
+} # }}} sub getval
+
+=item I<$res> = I<$obj>-E<gt>B<getthreshold> (I<%identifier>);
+
+Requests a threshold from the daemon. On success a hash-ref is returned with
+the threshold data. On error false is returned.
+
+=cut
+
+sub getthreshold # {{{
+{
+ my $obj = shift;
+ my %args = @_;
+
+ my $status;
+ my $fh = $obj->{'sock'} or confess ('object has no filehandle');
+ my $msg;
+ my $identifier;
+
+ my $ret = {};
+
+ $identifier = _create_identifier (\%args) or return;
+
+ $msg = 'GETTHRESHOLD ' . _escape_argument ($identifier) . "\n";
+ _debug "-> $msg";
+ print $fh $msg;
+
+ $msg = <$fh>;
+ chomp ($msg);
+ _debug "<- $msg\n";
+
+ ($status, $msg) = split (' ', $msg, 2);
+ if ($status <= 0)
+ {
+ $obj->{'error'} = $msg;
+ return;
+ }
+
+ for (my $i = 0; $i < $status; $i++)
+ {
+ my $entry = <$fh>;
+ chomp ($entry);
+ _debug "<- $entry\n";
+
+ if ($entry =~ m/^([^:]+):\s*(\S.*)$/)
+ {
+ my $key = $1;
+ my $value = $2;
+
+ $key =~ s/^\s+//;
+ $key =~ s/\s+$//;
+
+ $ret->{$key} = $value;
+ }
+ }
+
+ return ($ret);
+} # }}} sub getthreshold
=item I<$obj>-E<gt>B<putval> (I<%identifier>, B<time> =E<gt> I<$time>, B<values> =E<gt> [...]);
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'})
}
else
{
- my $time = $args{'time'} ? $args{'time'} : time ();
+ my $time;
+
+ if ("ARRAY" ne ref ($args{'values'}))
+ {
+ cluck ("Invalid `values' argument (expected an array ref)");
+ return;
+ }
+
+ if (! scalar @{$args{'values'}})
+ {
+ cluck ("Empty `values' array");
+ return;
+ }
+
+ $time = $args{'time'} ? $args{'time'} : time ();
$values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
}
- $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";
+ $msg = 'PUTVAL '
+ . _escape_argument ($identifier)
+ . $interval
+ . ' ' . _escape_argument ($values) . "\n";
+ _debug "-> $msg";
+ print $fh $msg;
+
+ $msg = <$fh>;
+ chomp ($msg);
+ _debug "<- $msg\n";
($status, $msg) = split (' ', $msg, 2);
return (1) if ($status == 0);
my $status;
my $fh = $obj->{'sock'} or confess;
- $msg = "LISTVAL\n";
- send ($fh, $msg, 0) or confess ("send: $!");
+ _debug "LISTVAL\n";
+ print $fh "LISTVAL\n";
$msg = <$fh>;
+ chomp ($msg);
+ _debug "<- $msg\n";
($status, $msg) = split (' ', $msg, 2);
if ($status < 0)
{
$msg = <$fh>;
chomp ($msg);
+ _debug "<- $msg\n";
($time, $ident) = split (' ', $msg, 2);
my $fh = $obj->{'sock'} or confess;
my $msg; # message sent to the socket
- my $opt_msg; # message of the notification
if (!$args{'message'})
{
$args{'time'} = time ();
}
- $opt_msg = $args{'message'};
- delete ($args{'message'});
-
$msg = 'PUTNOTIF '
- . join (' ', map { $_ . '=' . $args{$_} } (keys %args))
- . " message=$opt_msg\n";
+ . join (' ', map { $_ . '=' . _escape_argument ($args{$_}) } (keys %args))
+ . "\n";
- send ($fh, $msg, 0) or confess ("send: $!");
- $msg = undef;
- recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
+ _debug "-> $msg";
+ print $fh $msg;
+
+ $msg = <$fh>;
+ chomp ($msg);
+ _debug "<- $msg\n";
($status, $msg) = split (' ', $msg, 2);
return (1) if ($status == 0);
return;
}
- $msg .= " identifier=$ident_str";
+ $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: $!");
+ _debug "-> $msg";
+ print $fh $msg;
+
+ $msg = <$fh>;
+ chomp ($msg);
+ _debug "<- $msg\n";
($status, $msg) = split (' ', $msg, 2);
return (1) if ($status == 0);
return;
}
+sub error
+{
+ my $obj = shift;
+ if ($obj->{'error'})
+ {
+ return ($obj->{'error'});
+ }
+ return;
+}
+
=item I<$obj>-E<gt>destroy ();
Closes the socket before the object is destroyed. This function is also
Florian octo Forster E<lt>octo@verplant.orgE<gt>
=cut
+
+# vim: set fdm=marker :