File Coverage

blib/lib/RRDTool/Creator.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package RRDTool::Creator ;

# ============================================
#
#           Jacquelin Charbonnel - CNRS/LAREMA
#
#   $Id: Creator.pm 410 2008-03-11 21:45:09Z jaclin $
#
# ----
#
#   A generic abstract creator for round robin databases (RRD)
#
# ----
#   $LastChangedDate: 2008-03-11 22:45:09 +0100 (Tue, 11 Mar 2008) $
#   $LastChangedRevision: 410 $
#   $LastChangedBy: jaclin $
#   $URL: https://svn.math.cnrs.fr/jaclin/src/pm/RRDTool-Creator/Creator.pm $
#
# ============================================

require Exporter ;
@ISA = qw(Exporter);
@EXPORT=qw() ;

use Carp ;
use RRDTool::OO ;
use strict ;
use warnings ;

our $VERSION = "1.0" ; # $LastChangedRevision: 410 $
$Carp::CarpLevel = 1;

my $InSeconds = {
    "s" => 1
    , "mn" => 60
    , "h" => 60*60
    , "d" => 60*60*24
    , "w" => 60*60*24*7
    , "m" => 60*60*24*30        # supposed 30 days
    , "q" => 60*60*24*30*3      # 3 months
    , "y" => 60*60*24*30*12     # 12 months
    } ;

sub _getkey
{
  my ($key) = @_ ;
  $Carp::CarpLevel = 2 ;

  my @keys = grep /^$key/i,keys %$InSeconds ;
  croak "unknown '$key' unit" if scalar(@keys)==0 ;
  croak "ambigous '$key' unit (".join(",",@keys)." ?)" if scalar(@keys)>1 ;
  return lc($keys[0]) ;
}

sub _inSeconds
{
  my($duration,$allowed) = @_ ;
  $Carp::CarpLevel = 2 ;

  my ($num,$unit) = $duration=~/^\s*(\d+)\s*([a-zA-Z]+)\s*$/  or return undef ;
  my %allowed = map { $_ => 1 } @$allowed ;

  croak "unit '$unit' not allowed" unless exists $allowed{lc($unit)} ;
  my $key = _getkey($unit) ;

  return $num * $InSeconds->{$key} ;
}

#--
sub _new
{
  my($type,$units,%h) = @_ ;

  %h = map { /^-/ ? lc(substr($_,1)) : $_ ; } %h ;
  for my $k ("step")
  {
    croak "argument '$k' is missing" unless exists $h{lc($k)} ;
  }
  my $step = $h{"step"} ;
  my $s_step = _inSeconds($step,$units) or croak "bad format for step '$step'" ;

  my $this = {
    "step" => $s_step
    , "DS" => []
    , "RRA" => []
	} ;

  bless $this,$type ;
  return $this ;
}

#-------------------------------
sub _set_filename
{
  my($this,$filename) = @_ ;
  $this->{"filename"} = $filename ;
}

#-------------------------------
sub add
{
  my($this,%h) = @_ ;

  %h = map { /^-/ ? lc(substr($_,1)) : $_ ; } %h ;

  # normalisation
  if (exists $h{"cfunc"}) { $h{"cf"} = $h{"cfunc"} ; delete $h{"cfunc"} ; }

  push(@{$this->{"CF"}},$h{"cf"}) if exists $h{"cf"} ;
}

#-------------------------------

sub add_RRA
{
  my($this,%h) = @_ ;

  %h = map { /^-/ ? lc(substr($_,1)) : $_ ; } %h ;

  for my $k ("duration")
  {
    croak "'$k' argument is missing" unless exists $h{lc($k)} ;
  }

  my $duration = $h{"duration"} ;
  croak "possible duration are : "
    .join(",",keys %{$this->{"allowed_RRA_duration"}})
        unless exists $this->{"allowed_RRA_duration"}{$duration} ;

  push(@{$this->{"RRA"}},\%h) ;
}

#-------------------------------
sub add_data_source { add_DS(@_) ; }
sub add_DS
{
  my($this,%h) = @_ ;

  %h = map { /^-/ ? lc(substr($_,1)) : $_ ; } %h ;

  # normalisation
  if (exists $h{"name"}) { $h{"ds_name"} = $h{"name"} ; delete $h{"name"} ; }
  if (exists $h{"type"}) { $h{"dst"} = $h{"type"} ; delete $h{"type"} ; }

  $h{"min"} = "U" unless exists $h{"min"} ;
  $h{"max"} = "U" unless exists $h{"max"} ;
  $h{"heartbeat"} = 2*$this->{"step"} unless exists $h{"heartbeat"} ;

  for my $k ("ds_name","DST")
  {
    croak "'$k' argument is missing" unless exists $h{lc($k)} ;
  }

  push(@{$this->{"DS"}},\%h) ;
}

#-------------------------------
sub add_compute_DS
{
  my($this,%h) = @_ ;

  %h = map { /^-/ ? lc(substr($_,1)) : $_ ; } %h ;

  # normalisation
  if (exists $h{"name"}) { $h{"ds_name"} = $h{"name"} ; delete $h{"name"} ; }

  for my $k ("ds_name","rpn_expression")
  {
    croak "'$k' argument is missing" unless exists $h{lc($k)} ;
  }

  push(@{$this->{"DS"}},\%h) ;
}

#-------------------------------
sub compile
{
  my($this) = @_ ;

  my $rrd = RRDTool::OO->new("file" => $this->{"filename"});
  my @arg = () ;
  push(@arg,("step" => $this->{"step"})) ;

  for my $ds (@{$this->{"DS"}})
  {
    push(@arg,("data_source",
            {
                "name" => $ds->{"ds_name"}
                , "type" => $ds->{"dst"}
                , "heartbeat" => $ds->{"heartbeat"}
                , "min" => $ds->{"min"}
                , "max" => $ds->{"max"}
            }
        )
    )
  }

push(@arg,("archive",
    {
        "cfunc" => "LAST"
        , "cpoints" => 1
        , "rows" => $this->{"rows"}
    }
    )) ;

  for my $cpoint (@{$this->{"RRA"}})
  {
      for my $cfunc (@{$this->{"CF"}})
      {
        push(@arg,("archive",
            {
                "cfunc" => $cfunc
                , "cpoints" => $InSeconds->{substr($cpoint->{"duration"},0,1)}/($this->{"step"}*$this->{"rows"})
                , "rows" => $this->{"rows"}
            }
            )
        )
      }
  }
  $this->{"OO_create_arg"} = \@arg ;
  return @arg ;
}

#-------------------------------
sub create
{
  my($this,%h) = @_ ;

  %h = map { /^-/ ? lc(substr($_,1)) : $_ ; } %h ;

  # normalisation
  if (exists $h{"file"}) { $h{"filename"} = $h{"file"} ; delete $h{"file"} ; }

  $this->{"filename"} = $h{"filename"} if exists $h{"filename"} ;
  $this->{"OO_create_arg"} = $h{"OO_create_arg"} if exists $h{"OO_create_arg"} ;

  $this->compile() unless defined $this->{"OO_create_arg"} ;
  my $rrd = RRDTool::OO->new("file" => $h{"filename"});
  $rrd->create(@{$this->{"OO_create_arg"}}) ;
}

__END__