File Coverage

lib/RRDTool/Rawish.pm

Criterion	Covered	Total	%
statement	119	126	94.4
branch	69	88	78.4
condition	19	36	52.7
subroutine	23	25	92.0
pod	13	13	100.0
total	243	288	84.3

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__