package RRDTool::Rawish;
use strict;
use warnings;
use 5.008;
use Carp ();
use Capture::Tiny qw(capture);
use File::Which ();
our $VERSION = '0.040';
sub new {
my ($class, @args) = @_;
my %args = @args == 1 && ref $args[0] eq 'HASH' ? %{$args[0]} : @args;
my $rrdtool_path = $args{rrdtool_path} || File::Which::which('rrdtool')
or Carp::croak 'Not found rrdtool command';
if (not -x $rrdtool_path) {
Carp::croak "Cannot execute $rrdtool_path";
}
return bless {
command => $rrdtool_path,
remote => $args{remote},
rrdfile => $args{rrdfile},
rrderror => "",
}, $class;
}
sub version {
my $self = shift;
my ($ret, $exit_status) = $self->_readpipe($self->{command}, 'version');
$ret =~ /^RRDtool (\d+)\.(\d+).(\d+)/;
return "$1.$2$3"; # like "1.47"
}
sub errstr { $_[0]->{rrderror} }
sub create {
my ($self, $params, $opts) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
Carp::croak 'Not ARRAY reference: params' if ref($params) ne 'ARRAY';
Carp::croak 'Not HASH reference: opts' if defined $opts && ref($opts) ne 'HASH';
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my $exit_status = $self->_system($self->{command}, 'create', $self->{rrdfile}, _opt_array($opts), @$params);
return $exit_status;
}
sub update {
my ($self, $params, $opts) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
Carp::croak 'Not ARRAY reference: params' if ref($params) ne 'ARRAY';
Carp::croak 'Not HASH reference: opts' if defined $opts && ref($opts) ne 'HASH';
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my $exit_status = $self->_system($self->{command}, 'update', $self->{rrdfile}, _opt_array($opts), @$params);
return $exit_status;
}
sub graph {
my ($self, $filename, $params, $opts) = @_;
Carp::croak 'Require filename' unless $filename;
Carp::croak 'Not ARRAY reference: $params' if ref($params) ne 'ARRAY';
Carp::croak 'Not HASH reference: $opts' if defined $opts && ref($opts) ne 'HASH';
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my ($img, $exit_status) = $self->_readpipe($self->{command}, 'graph', $filename, _opt_array($opts), @$params);
return $img;
}
sub dump {
my ($self, $opts) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
Carp::croak 'Not HASH reference: $opts' if defined $opts && ref($opts) ne 'HASH';
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my ($xml, $exit_status) = $self->_readpipe($self->{command}, 'dump', $self->{rrdfile}, _opt_array($opts));
return $xml;
}
sub restore {
my ($self, $xmlfile, $opts) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
Carp::croak 'Require xmlfile' if not defined $xmlfile;
Carp::croak 'Not HASH reference: opts' if defined $opts && ref($opts) ne 'HASH';
my $ret = $self->_system($self->{command}, 'restore', $xmlfile, $self->{rrdfile}, _opt_array($opts));
return $ret;
}
sub lastupdate {
my ($self) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
my $opts = {};
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my ($text, $exit_status) = $self->_readpipe($self->{command}, 'lastupdate', $self->{rrdfile}, _opt_array($opts));
return $text if (!$text and $exit_status != 0);
my $lines = [ split "\n", $text ];
my ($timestamp, $tmp) = split ':', $lines->[2];
return $timestamp;
}
sub fetch {
my ($self, $CF, $opts) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
Carp::croak 'Require CF' if not defined $CF;
Carp::croak 'Not HASH reference: opts' if defined $opts && ref($opts) ne 'HASH';
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my ($text, $exit_status) = $self->_readpipe($self->{command}, 'fetch', $self->{rrdfile}, $CF, _opt_array($opts));
return $text if (!$text and $exit_status != 0);
my $lines = [ split "\n", $text ];
return $lines;
}
sub xport {
my ($self, $params, $opts) = @_;
Carp::croak 'Not ARRAY reference: params' if ref($params) ne 'ARRAY';
Carp::croak 'Not HASH reference: opts' if defined $opts && ref($opts) ne 'HASH';
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my ($xml, $exit_status) = $self->_readpipe($self->{command}, 'xport', _opt_array($opts), @$params);
return $xml;
}
sub info {
my ($self) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
my $opts_str = $self->{remote} ? "--daemon" : "";
my ($text, $exit_status) = $self->_readpipe($self->{command}, 'info', $self->{rrdfile}, $opts_str);
return $text if (!$text and $exit_status != 0);
my $value = {};
my $lines = [ split "\n", $text ];
for (@$lines) {
my ($k, $v) = split ' = ', $_;
$v =~ s/"(.+)"/$1/g;
if ($k =~ /^rra\[(\d+)]\.(.+)\[(\d+)\]\.(.+)$/) { # rra[0].cdp_prep[0].value = NaN
$value->{rra}->[$1]->{$2}->[$3]->{$4} = $v;
}
elsif ($k =~ /^rra\[(\d+)\]\.(.+)$/) { # rra[0].cf = "LAST"
$value->{rra}->[$1]->{$2} = $v;
}
elsif ($k =~ /^ds\[(.+)\]\.(.+)$/) { # ds[rx].type = "DERIVE"
$value->{ds}->{$1}->{$2} = $v;
}
else {
$value->{$k} = $v;
}
}
return $value;
}
sub flushcached {
my ($self, $opts) = @_;
Carp::croak 'Require rrdfile' if not defined $self->{rrdfile};
Carp::croak 'Require remote' if not defined $self->{remote};
$opts->{'--daemon'} = $self->{remote} if $self->{remote};
my $exit_status = $self->_system($self->{command}, 'flushcached', _opt_array($opts), $self->{rrdfile});
return $exit_status;
}
sub _system {
my ($self, @expr) = @_;
my ($stdout, $stderr, $exit_status) = capture {
system(_sanitize(join(" ", @expr)));
};
chomp $stderr;
$self->{rrderror} = $stderr if $exit_status != 0;
return $exit_status;
}
sub _readpipe {
my ($self, @expr) = @_;
my ($stdout, $stderr, $exit_status) = capture {
system(_sanitize(join(" ", @expr)));
};
chomp $stderr;
$self->{rrderror} = $stderr if $exit_status != 0;
return ($stdout, $exit_status);
}
sub _sanitize {
my $command = shift;
$command =~ s/[^a-z0-9#_@\s\-\.\,\:\/=\+\-\*\%]//gi;
return $command;
}
sub _opt_array {
my ($opts) = @_;
return map {
($opts->{$_} eq 1) ? $_ : ($_, $opts->{$_})
} sort(keys %$opts);
}
1;
__END__
1;
__END__
=head1 NAME
RRDTool::Rawish - A RRDtool command wrapper with rawish interface
=head1 SYNOPSIS
use RRDTool::Rawish;
my $rrd = RRDTool::Rawish->new(
rrdfile => 'rrdtest.rrd', # path to rrdfile
remote => 'rrdtest.com:11111', # option for rrdcached
rrdtool_path => '/opt/rrdtool/bin/rrdtool', # option path to rrdtool
);
my $create_status = $rrd->create(["DS:rx:DERIVE:40:0:U", "DS:tx:DERIVE:40:0:U", "RRA:LAST:0.5:1:240"], {
'--start' => '1350294000',
'--step' => '20',
'--no-overwrite' => '1',
});
my $update_status = $rrd->update([
"1350294020:0:0",
"1350294040:50:100",
"1350294060:80:150",
"1350294080:100:200",
"1350294100:180:300",
"1350294120:220:380",
"1350294140:270:400"
]);
my $img = $rrd->graph('-', [
"DEF:rx=rrdtest2.rrd:rx:LAST",
"DEF:tx=rrdtest2.rrd:tx:LAST",
"LINE1:rx:rx#00F000",
"LINE1:tx#0000F0",
]);
# error message
$rrd->errstr; # => "ERROR: hogehoge"
=head1 DESCRIPTION
RRDTool::Rawish is a RRDtool command wrapper class with rawish interface.
You can use the class like RRDtool command interface.
Almost all of modules with RRD prefix are RRDs module wrappers.
It's troublesome to use RRDs with variable environments because it's a XS module and moreover not a CPAN module.
In contrast, RRDTool::Rawish has less dependencies and it's easy to install it.
=head1 METHODS
=over 4
=item my $rrd = RRDTool::Rawish->new([%args])
Creates a new instance of RRDTool::Rawish. %args need to be specified in key => value format.
The following options are supported:
=over 4
=item rrdfile
This option specifies the rrdfile that L<RRD::Rawish> is working on. It's
mandatory for most of the rrdtool operations.
=item rrdtool_path
This is the path to the rrdtool binary that should be used. RRD::Rawish will
use the rrdtool binary that's in the user path. You can override this behavior
to use a different rrdtool binary. This allows multiple rrdtools to be
installed, it also simplifies the usage of a binary that's not in the default
path.
=item remote
This is option to support the rrdcached daemon. You can specifiy a unix file or
network socket. Unix file sockets need to be prefixed with C<unix:>
e.g. C<unix:/var/run/rrdcached.sock>. As L<RRD::Rawish> uses the rrdtool
binary itself the environment variable C<RRDCACHED_ADDRESS> is well respected.
Setting the environment variable allows transparent integration.
=back
=item $rrd->version()
Returns rrdtool's version like "1.47".
=item $rrd->errstr()
Returns rrdtool's stderr string. If no error occurs, it returns empty string.
=item $rrd->create($params, [\%opts])
Returns exit status.
rrdtool create
=item $rrd->update($params, [\%opts])
Returns exit status.
rrdtool update
=item $rrd->graph($filename, $params, [\%opts])
Returns exit status
rrdtool graph
Returns image binary.
=item $rrd->dump([\%opts])
rrdtool dump
Returns xml data.
=item $rrd->restore($xmlfile, [\%opts])
rrdtool restore
Returns exit status.
=item $rrd->lastupdate
rrdtool lastupdate
Returns timestamp.
=item $rrd->fetch
rrdtool fetch
Returns output lines as an ARRAY reference
=item $rrd->xport
rrdtool xport
Returns xml data.
=item $rrd->flushcached
rrdtool flushcached
Sends a C<flush> command to rrdcached for the C<rrdfile>.
Returns exit status.
=item $rrd->info
rrdtool info
Returns info as a HASH reference.
Examples:
is $value->{filename}, "rrd_test.rrd";
is $value->{rrd_version}, "0003";
is $value->{step}, 20;
is $value->{last_update}, 1350294000;
is $value->{header_size}, 904;
is $value->{ds}->{rx}->{index}, 0;
is $value->{ds}->{rx}->{minimal_heartbeat}, 40;
is $value->{ds}->{rx}->{min}, "0.0000000000e+00";
is $value->{ds}->{rx}->{max}, "NaN";
is $value->{ds}->{rx}->{last_ds}, "U";
is $value->{ds}->{rx}->{value}, "0.0000000000e+00";
is $value->{ds}->{rx}->{unknown_sec}, 0;
is $value->{ds}->{tx}->{index}, 1;
is $value->{ds}->{tx}->{type}, "DERIVE";
is $value->{ds}->{tx}->{minimal_heartbeat}, 40;
is $value->{ds}->{tx}->{min}, "0.0000000000e+00";
is $value->{ds}->{tx}->{max}, "NaN";
is $value->{ds}->{tx}->{last_ds}, "U";
is $value->{ds}->{tx}->{value}, "0.0000000000e+00";
is $value->{ds}->{tx}->{unknown_sec}, 0;
is $value->{rra}->[0]->{cf}, "LAST";
is $value->{rra}->[0]->{rows}, 240;
is $value->{rra}->[0]->{cur_row}, 95;
is $value->{rra}->[0]->{pdp_per_row}, 1;
is $value->{rra}->[0]->{xff}, "5.0000000000e-01";
is $value->{rra}->[0]->{cdp_prep}->[0]->{value}, "NaN";
is $value->{rra}->[0]->{cdp_prep}->[0]->{unknown_datapoints}, 0;
is $value->{rra}->[0]->{cdp_prep}->[1]->{value}, "NaN";
is $value->{rra}->[0]->{cdp_prep}->[1]->{unknown_datapoints}, 0;
=back
=head1 AUTHOR
Yuuki Tsubouchi C<< <yuuki@cpan.org> >>
=head1 THANKS TO
Shoichi Masuhara
=head1 SEE ALSO
L<RRDtool Documentation|http://oss.oetiker.ch/rrdtool/>
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2013, Yuuki Tsubouchi C<< <yuuki@cpan.org> >>. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
=cut