RRDTool-OO-0.33/0000755000175000017500000000000012166721267013443 5ustar mschillimschilliRRDTool-OO-0.33/eg/0000755000175000017500000000000012166721267014036 5ustar mschillimschilliRRDTool-OO-0.33/eg/dt0000755000175000017500000000417511411272332014364 0ustar mschillimschilli#!/usr/local/bin/perl ############################################################ # Create a sample graph # Mike Schilli , 2004 ############################################################ use strict; use warnings; use RRDTool::OO; use Log::Log4perl qw(:easy); use DateTime; Log::Log4perl->easy_init($DEBUG); my $DB = "example.rrd"; my $IMG = "example.png"; my $rrd = RRDTool::OO->new(file => $DB); # Use a reproducable point in time my $start_time = DateTime->now(); my $nof_iterations = 40; # Define the RRD my $rc = $rrd->create( start => $start_time->clone->subtract( hours => 1 ), step => 60, data_source => { name => 'load1', type => 'GAUGE', }, data_source => { name => 'load2', type => 'GAUGE', }, archive => { rows => 50, }, ); my $time = $start_time->clone()->subtract( minutes => 1); # Pump in values for(0..$nof_iterations) { $time->add( minutes => 1 ); my $value = 2 + $_ * 0.1; $rrd->update( time => $time, values => { load1 => $value, load2 => $value+1, } ); } # Draw a graph of two different data sources, # stacked on top of each other $rrd->graph( image => $IMG, vertical_label => 'A Nice Area Graph', start => $start_time, end => $start_time->clone->add( minutes => $nof_iterations ), width => 700, height => 300, color => { back => '#eeeeee', arrow => '#ff0000', canvas => '#eebbbb', }, # First graph draw => { name => 'some_stupid_draw', type => "area", color => '0000ff', legend => 'first legend', dsname => 'load1', }, # Second graph draw => { type => "stack", color => '00ff00', dsname => 'load2', legend => 'second legend', }, ); print "$IMG ready.\n"; RRDTool-OO-0.33/eg/graph.pl0000755000175000017500000000431311411272332015462 0ustar mschillimschilli#!/usr/local/bin/perl ############################################################ # Create a sample graph # Mike Schilli , 2004 ############################################################ use strict; use warnings; use RRDTool::OO; use Log::Log4perl qw(:easy); Log::Log4perl->easy_init($DEBUG); my $DB = "example.rrd"; my $IMG = "example.png"; my $rrd = RRDTool::OO->new(file => $DB); # Use a reproducable point in time my $start_time = 1080460200; my $nof_iterations = 40; my $end_time = $start_time + $nof_iterations * 60; # Define the RRD my $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load1', type => 'GAUGE', }, data_source => { name => 'load2', type => 'GAUGE', }, archive => { rows => 50, }, ); # Pump in values for(0..$nof_iterations) { my $time = $start_time + $_ * 60; my $value = 2 + $_ * 0.1; $rrd->update( time => $time, values => { load1 => $value, load2 => $value+1, } ); } # Draw a graph of two different data sources, # stacked on top of each other $rrd->graph( image => $IMG, vertical_label => 'A Nice Area Graph', start => $start_time, end => $start_time + $nof_iterations * 60, width => 700, height => 300, color => { back => '#eeeeee', arrow => '#ff0000', canvas => '#eebbbb', }, # First graph draw => { name => 'some_stupid_draw', type => "area", color => '0000ff', legend => 'first legend', dsname => 'load1', }, # Second graph draw => { type => "stack", color => '00ff00', dsname => 'load2', legend => 'second legend', }, # gprint => { # draw => 'some_stupid_draw', # format => 'avg=%lf', # #cfunc => 'MIN', # }, ); print "$IMG ready.\n"; RRDTool-OO-0.33/lib/0000755000175000017500000000000012166721267014211 5ustar mschillimschilliRRDTool-OO-0.33/lib/RRDTool/0000755000175000017500000000000012166721267015476 5ustar mschillimschilliRRDTool-OO-0.33/lib/RRDTool/OO.pm0000644000175000017500000021772412166720331016355 0ustar mschillimschillipackage RRDTool::OO; use 5.6.0; use strict; use warnings; use Carp; use RRDs; use Storable; use Data::Dumper; use Log::Log4perl qw(:easy); our $VERSION = '0.33'; # Define the mandatory and optional parameters for every method. our $OPTIONS = { new => { mandatory => ['file'], optional => [qw(raise_error dry_run strict)], }, create => { mandatory => [qw(data_source)], optional => [qw(step start hwpredict archive)], data_source => { mandatory => [qw(name type)], optional => [qw(min max heartbeat)], }, archive => { mandatory => [qw(rows)], optional => [qw(cfunc cpoints xff)], }, hwpredict => { mandatory => [qw(rows)], optional => [qw( alpha beta gamma seasonal_period threshold window_length )], }, }, update => { mandatory => [qw()], optional => [qw(time value values)], }, graph => { mandatory => [qw(image)], optional => [qw(vertical_label title start end x_grid y_grid alt_y_grid no_minor alt_y_mrtg alt_autoscale alt_autoscale_max base units_exponent units_length width height interlaced imginfo imgformat overlay unit lazy upper_limit lower_limit rigid logarithmic color no_legend only_graph force_rules_legend title step draw line area shift tick print gprint vrule hrule comment font no_gridfit font_render_mode font_smoothing_threshold slope_mode tabwidth units watermark zoom )], draw => { mandatory => [qw()], optional => [qw(file dsname cfunc thickness type color legend name cdef vdef stack step start end )], }, color => { mandatory => [qw()], optional => [qw(back canvas shadea shadeb grid mgrid font frame arrow)], }, font => { mandatory => [qw(name)], optional => [qw(element size)], }, print => { mandatory => [qw()], optional => [qw(draw format cfunc)], }, gprint => { mandatory => [qw(format)], optional => [qw(draw cfunc)], }, vrule => { mandatory => [qw(time)], optional => [qw(color legend)], }, hrule => { mandatory => [qw(value)], optional => [qw(color legend)], }, comment => { mandatory => [], optional => [], }, line => { mandatory => [qw(value)], optional => [qw(width color legend stack)], }, area => { mandatory => [qw(value)], optional => [qw(color legend stack)], }, tick => { mandatory => [qw()], optional => [qw(draw color legend fraction)], }, shift => { mandatory => [qw(offset)], optional => [qw(draw)], }, }, xport => { mandatory => [qw(xport)], optional => [qw(def cdef start end step maxrows daemon)], def => { mandatory => [qw(file vname dsname cfunc)], optional => [], }, cdef => { mandatory => [qw(vname rpn)], optional => [], }, xport => { mandatory => [qw(vname)], optional => [qw(legend)], }, }, fetch_start=> { mandatory => [qw()], optional => [qw(cfunc start end resolution)], }, fetch_next => { mandatory => [], optional => [], }, dump => { mandatory => [], optional => [], }, restore => { mandatory => [qw()], optional => [qw(xml range_check)], }, tune => { mandatory => [], optional => [qw(heartbeat minimum maximum type name)], }, last => { mandatory => [], optional => [], }, info => { mandatory => [], optional => [], }, rrdresize => { mandatory => [], optional => [], }, rrdcgi => { mandatory => [], optional => [], }, }; my %RRDs_functions = ( create => \&RRDs::create, fetch => \&RRDs::fetch, update => \&RRDs::update, updatev => \&RRDs::updatev, graph => \&RRDs::graph, graphv => \&RRDs::graphv, info => \&RRDs::info, dump => \&RRDs::dump, restore => \&RRDs::restore, tune => \&RRDs::tune, last => \&RRDs::last, info => \&RRDs::info, rrdresize => \&RRDs::rrdresize, xport => \&RRDs::xport, rrdcgi => \&RRDs::rrdcgi, ); ################################################# sub option_add { ################################################# my($self, $method, @options) = @_; my @parts = split m#/#, $method; my $ref = $OPTIONS; $ref = $ref->{$_} for @parts; push @{ $ref->{optional} }, $_ for @options; } ################################################# sub check_options { ################################################# my($self, $method, $options) = @_; $options = [] unless defined $options; my %options_hash = (@$options); my @parts = split m#/#, $method; my $ref = $OPTIONS; $ref = $ref->{$_} for @parts; my %optional = map { $_ => 1 } @{$ref->{optional}}; my %mandatory = map { $_ => 1 } @{$ref->{mandatory}}; # Check if we got all mandatory parameters for(@{$ref->{mandatory}}) { if(! exists $options_hash{$_}) { Log::Log4perl->get_logger("")->logcroak( "Mandatory parameter '$_' not set " . "in $method() (@{[%mandatory]}) (@$options)"); } } # Check if all of the optional parameters we got are indeed # valid optional parameters if($self->{strict}) { for(keys %options_hash) { if(! exists $optional{$_} and ! exists $mandatory{$_}) { Log::Log4perl->get_logger("")->logcroak( "Illegal parameter '$_' in $method()"); } } } 1; } ################################################# sub new { ################################################# my($class, %options) = @_; my $self = { raise_error => 1, strict => 1, dry_run => 0, exec_subref => undef, exec_args => [], exec_func => [], print_results => [], meta => { discovered => 0, cfuncs => [], cfuncs_hash => {}, dsnames => [], dsnames_hash => {}, }, %options, }; bless $self, $class; # For this one, we need to be strict local $self->{strict} = 1; $self->check_options("new", [%options]); return $self; } ################################################# sub first_def { ################################################# foreach(@_) { return $_ if defined $_; } return undef; } ################################################# sub create { ################################################# my($self, @options) = @_; $self->check_options("create", \@options); my %options_hash = @options; # If it's a DateTime object, handle it gracefully if( ref $options_hash{start} eq "DateTime" ) { $options_hash{start} = $options_hash{start}->epoch(); } my @archives; my @data_sources; my @hwpredict; for(my $i=0; $i < @options; $i += 2) { # Push copies (!) of original hashes onto internal data structures push @archives, { %{$options[$i+1]} } if $options[$i] eq "archive"; push @hwpredict, { %{$options[$i+1]} } if $options[$i] eq "hwpredict"; push @data_sources, { %{$options[$i+1]} } if $options[$i] eq "data_source"; } if(!@archives and !@hwpredict) { LOGDIE "No archives specified (use either 'archive' or 'hwpredict')"; } DEBUG "Archives: ", scalar @archives, " Sources: ", scalar @data_sources; for(@archives) { $self->check_options("create/archive", [%$_]); } for(@data_sources) { $self->check_options("create/data_source", [%$_]); } for(@hwpredict) { $self->check_options("create/hwpredict", [%$_]); } my @rrdtool_options = ($self->{file}); push @rrdtool_options, "--start", $options_hash{start} if exists $options_hash{start}; push @rrdtool_options, "--step", $options_hash{step} if exists $options_hash{step}; # RRDtool default setting $options_hash{step} ||= 300; for(@data_sources) { # DS:ds-name:DST:heartbeat:min:max DEBUG "data_source: @{[%$_]}"; $_->{heartbeat} ||= $options_hash{step} * 2; push @rrdtool_options, "DS:$_->{name}:$_->{type}:$_->{heartbeat}:" . (defined $_->{min} ? $_->{min} : "U") . ":" . (defined $_->{max} ? $_->{max} : "U"); $self->meta_data("dsnames", $_->{name}, 1); } for(@archives) { # RRA:CF:xff:steps:rows DEBUG "archive: @{[%$_]}"; if(! exists $_->{xff}) { $_->{xff} = 0.5; } $_->{cpoints} ||= 1; if($_->{cpoints} > 1 and !exists $_->{cfunc}) { LOGDIE "Must specify cfunc if cpoints > 1"; } if(! exists $_->{cfunc}) { $_->{cfunc} = 'MAX'; } $self->meta_data("cfuncs", $_->{cfunc}, 1); push @rrdtool_options, "RRA:$_->{cfunc}:$_->{xff}:$_->{cpoints}:$_->{rows}"; } my $hwpredict_num = (scalar @archives) + 1; for(@hwpredict) { # RRA:HWPREDICT:rows:alpha:beta:seasonal period[:rra-num] # RRA:SEASONAL:seasonal period:gamma:rra-num # RRA:DEVSEASONAL:seasonal period:gamma:rra-num # RRA:DEVPREDICT:rows:rra-num # RRA:FAILURES:rows:threshold:window length:rra-num DEBUG "hwpredict: @{[%$_]}"; def_or($_->{alpha}, 0.1); def_or($_->{beta}, 0.1); def_or($_->{gamma}, $_->{alpha}); def_or($_->{threshold}, 7); def_or($_->{window_length}, 9); def_or($_->{seasonal_period}, int($_->{rows}/5) ); # push @rrdtool_options, # "RRA:HWPREDICT:$_->{rows}:$_->{alpha}:" . # "$_->{beta}:$_->{seasonal_period}:"; #0 push @rrdtool_options, "RRA:HWPREDICT:$_->{rows}:$_->{alpha}:" . "$_->{beta}:$_->{seasonal_period}:" . ($hwpredict_num + 1); #1 push @rrdtool_options, "RRA:SEASONAL:$_->{seasonal_period}:$_->{gamma}:" . ($hwpredict_num + 0); #2 push @rrdtool_options, "RRA:DEVSEASONAL:$_->{seasonal_period}:$_->{gamma}:" . ($hwpredict_num + 0); #3 push @rrdtool_options, "RRA:DEVPREDICT:$_->{rows}:" . ($hwpredict_num + 2); #4 push @rrdtool_options, "RRA:FAILURES:$_->{rows}:$_->{threshold}:" . "$_->{window_length}:" . ($hwpredict_num + 2); $hwpredict_num++; } $self->RRDs_execute("create", @rrdtool_options); } ################################################# sub RRDs_execute { ################################################# my ($self, $command, @args) = @_; my $logger = get_logger("rrdtool"); $logger->info("rrdtool '$command' ", join " ", map { "'$_'" } @args); if ($self->{dry_run}) { $self->{exec_subref} = $RRDs_functions{$command} ; $self->{exec_args} = \@args ; $self->{exec_func} = $command; return ; } my @rc; my $error; if(wantarray) { @rc = $RRDs_functions{$command}->(@args); INFO "rrdtool rc=(", array_as_string(\@rc), ")"; $error = 1 unless defined $rc[0]; } else { $rc[0] = $RRDs_functions{$command}->(@args); INFO "rrdtool rc=(", array_as_string(\@rc), ")"; $error = 1 unless $rc[0]; } if($error) { LOGDIE "rrdtool $command @args failed: ", $self->error_message() if $self->{raise_error}; } # Important to return no array in scalar context. if(wantarray) { return @rc; } else { return $rc[0]; } } ################################################# sub get_exec_env { ################################################# my($self) = @_; # returns stored environment in previous dry-run exec return ($self->{exec_subref}, $self->{exec_args}, $self->{exec_func}, ); } ################################################# sub update { ################################################# my($self, @options) = @_; # Expand short form @options = (value => $options[0]) if @options == 1; $self->check_options("update", \@options); my %options_hash = @options; $options_hash{time} = "N" unless exists $options_hash{time}; # If it's a DateTime object, handle it gracefully if( ref $options_hash{time} eq "DateTime" ) { $options_hash{time} = $options_hash{time}->epoch(); } my $update_string = "$options_hash{time}:"; my @update_options = (); if(exists $options_hash{values}) { if(ref($options_hash{values}) eq "HASH") { # Do the template magic push @update_options, "--template", join(":", keys %{$options_hash{values}}); $update_string .= join ":", values %{$options_hash{values}}; } else { # We got multiple values in correct order $update_string .= join ":", @{$options_hash{values}}; } } else { # We just have a single value $update_string .= $options_hash{value}; } my $caller = (caller(1))[3] ? (caller(1))[3] : ''; my $updatecmd = $caller eq __PACKAGE__."::updatev" ? 'updatev' : 'update'; my ($print_results) = $self->RRDs_execute($updatecmd, $self->{file}, @update_options, $update_string); if(!defined $print_results) { return undef; } $self->print_results( $print_results ); return 1; } ################################################# sub updatev { ################################################# &update (@_); } ################################################# sub fetch_start { ################################################# my($self, @options) = @_; $self->check_options("fetch_start", \@options); my %options_hash = @options; if(!exists $options_hash{cfunc}) { my $cfuncs = $self->meta_data("cfuncs"); LOGDIE "No default archive cfunc" unless defined $cfuncs->[0]; $options_hash{cfunc} = $cfuncs->[0]; DEBUG "Getting default cfunc '$options_hash{cfunc}'"; } my $cfunc = $options_hash{cfunc}; delete $options_hash{cfunc}; @options = add_dashes(\%options_hash); INFO "rrdtool fetch $self->{file} $cfunc @options"; ($self->{fetch_time_current}, $self->{fetch_time_step}, $self->{fetch_ds_names}, $self->{fetch_data}) = $self->RRDs_execute("fetch", $self->{file}, $cfunc, @options); $self->{fetch_idx} = 0; } ################################################# sub fetch_next { ################################################# my($self) = @_; if(!defined $self->{fetch_data}->[$self->{fetch_idx}]) { INFO "Idx $self->{fetch_idx} returned undef"; return (); } my @values = @{$self->{fetch_data}->[$self->{fetch_idx}++]}; # Put the time of the data point in front unshift @values, $self->{fetch_time_current}; INFO "rrdtool fetch $self->{file} ", array_as_string(\@values) if @values; $self->{fetch_time_current} += $self->{fetch_time_step}; return @values; } ################################################# sub array_as_string { ################################################# my($arrayref) = @_; return join "-", map { defined $_ ? $_ : '[undef]' } @$arrayref; } ################################################# sub fetch_skip_undef { ################################################# my($self) = @_; { if(!defined $self->{fetch_data}->[$self->{fetch_idx}]) { return undef; } my $value = $self->{fetch_data}->[$self->{fetch_idx}]->[0]; unless(defined $value) { $self->{fetch_idx}++; $self->{fetch_time_current} += $self->{fetch_time_step}; redo; } } } ################################################# sub add_dashes { ################################################# my($options_hashref, $assign_hashref) = @_; $assign_hashref = {} unless $assign_hashref; my @options = (); foreach(keys %$options_hashref) { (my $newname = $_) =~ s/_/-/g; if($assign_hashref->{$_}) { push @options, "--$newname=$options_hashref->{$_}"; } elsif(defined $options_hashref->{$_}) { push @options, "--$newname", $options_hashref->{$_}; } else { push @options, "--$newname"; } } return @options; } ################################################# sub error_message { ################################################# my($self) = @_; return RRDs::error(); } ################################################# sub graph { ################################################# my($self, @params) = @_; my @options = @{ Storable::dclone( \@params ) }; my @trailing_options = (); $self->check_options("graph", \@options); $self->print_results( [] ); my @colors = (); my @prints = (); my @vrules = (); my @hrules = (); my @fonts = (); my @items = (); my $nof_draws = 0; my @draws = (); my %options_hash = @options; my $draw_count = 1; my $image = delete $options_hash{image}; delete $options_hash{draw}; for(my $i=0; $i < @options; $i += 2) { if($options[$i] eq "draw") { push @items, ['draw', $options[$i+1]]; push @draws, $options[$i+1]; $nof_draws++; } elsif($options[$i] eq "color") { $self->check_options("graph/color", [%{$options[$i+1]}]); for(keys %{$options[$i+1]}) { push @colors, "--color", uc($_) . "$options[$i+1]->{$_}"; } } elsif($options[$i] eq "print") { $self->check_options("graph/print", [%{$options[$i+1]}]); push @items, ['print', [$options[$i], $options[$i+1]]]; } elsif($options[$i] eq "gprint") { $self->check_options("graph/gprint", [%{$options[$i+1]}]); push @items, ['print', [$options[$i], $options[$i+1]]]; } elsif($options[$i] eq "comment") { push @items, ['print', option_expand(@options[$i, $i+1])]; } elsif($options[$i] eq "line") { $self->check_options("graph/line", [%{$options[$i+1]}]); push @items, ['print', option_expand(@options[$i, $i+1])]; } elsif($options[$i] eq "area") { $self->check_options("graph/area", [%{$options[$i+1]}]); push @items, ['print', option_expand(@options[$i, $i+1])]; } elsif($options[$i] eq "vrule") { $self->check_options("graph/vrule", [%{$options[$i+1]}]); push @items, ['vrule', [$options[$i], $options[$i+1]]]; } elsif($options[$i] eq "hrule") { $self->check_options("graph/hrule", [%{$options[$i+1]}]); push @items, ['hrule', [$options[$i], $options[$i+1]]]; } elsif($options[$i] eq "tick") { $self->check_options("graph/tick", [%{$options[$i+1]}]); push @items, ['print', option_expand(@options[$i, $i+1])]; } elsif($options[$i] eq "shift") { $self->check_options("graph/shift", [%{$options[$i+1]}]); push @items, ['print', option_expand(@options[$i, $i+1])]; } elsif($options[$i] eq "font") { push @fonts,$options[$i+1]; } } delete $options_hash{color}; delete $options_hash{vrule}; delete $options_hash{hrule}; delete $options_hash{'print'}; delete $options_hash{gprint}; delete $options_hash{comment}; delete $options_hash{font}; delete $options_hash{line}; delete $options_hash{area}; delete $options_hash{tick}; delete $options_hash{'shift'}; # If it's a DateTime object, handle it gracefully for my $o (qw(start end)) { if( ref $options_hash{$o} eq "DateTime" ) { $options_hash{$o} = $options_hash{$o}->epoch(); } } @options = add_dashes(\%options_hash); # Set dsname default if(!exists $options_hash{dsname}) { my $dsname = $self->default("dsname"); LOGDIE "No default archive dsname" unless defined $dsname; $options_hash{dsname} = $dsname; DEBUG "Getting default dsname '$dsname'"; } # Set cfunc default if(!exists $options_hash{cfunc}) { my $cfunc = $self->default("cfunc"); LOGDIE "No default archive cfunc" unless defined $cfunc; $options_hash{cfunc} = $cfunc; DEBUG "Getting default cfunc '$cfunc'"; } # Push a pseudo draw if there's none. unshift @items, ['draw', {}] unless $nof_draws; for(@fonts) { $self->check_options("graph/font", [%$_]); $_->{size} ||= 8; $_->{element} ||= 'default'; $_->{name} ||= ''; # but this breaks. # Need to issue an error eventually. push @options,"--font", uc($_->{element}) . ":" . $_->{size} . ":" . $_->{name}; } for my $item (@items) { if($item->[0] eq 'draw') { $self->process_draw($item->[1], \@options, \%options_hash, $draw_count); $draw_count++; } elsif($item->[0] eq 'vrule') { $self->process_vrule($item->[1], \@options); } elsif($item->[0] eq 'hrule') { $self->process_hrule($item->[1], \@options); } elsif($item->[0] eq 'print') { for(@$item[1..$#$item]) { $self->process_print($_, \@options, \@draws); } } } push @options, @colors; unshift @options, $image; my $caller = (caller(1))[3] ? (caller(1))[3] : ''; my $graphcmd = $caller eq __PACKAGE__."::graphv" ? 'graphv' : 'graph'; my($print_results, $img_width, $img_height) = $self->RRDs_execute($graphcmd, @options); if(!defined $print_results) { return undef; } $self->print_results( $print_results ); return 1; } ################################################# sub graphv { ################################################# &graph (@_); } ########################################### sub print_results { ########################################### my($self, $results) = @_; if(defined $results) { $self->{results} = $results; } return $self->{results}; } ################################################# sub option_expand { ################################################# my($oname, $ovalue) = @_; # If $ovalue is an array ref, return ($oname, $element) # for each of the elements in @$ovalue. my @result; if ( ref($ovalue) eq 'ARRAY' ) { push @result, [$oname, $_] foreach @$ovalue; } else { push @result, [$oname, $ovalue]; } return @result; } ################################################# sub dump { ################################################# my($self, @options) = @_; $self->RRDs_execute("dump", $self->{file}, @options); } ################################################# sub restore { ################################################# my($self, @options) = @_; # Called with only the xml file if(@options == 1) { @options = (xml => $options[0]); } my %options_hash = @options; my $xml = delete $options_hash{xml}; @options = add_dashes(\%options_hash); $self->RRDs_execute("restore", $xml, $self->{file}, @options); } ################################################# sub tune { ################################################# my($self, @options) = @_; my %options_hash = @options; my $dsname = first_def $options_hash{dsname}, $self->default("dsname"); delete $options_hash{dsname}; @options = (); my %map = qw( type data-source-type name data-source-rename ); for my $param (qw(heartbeat minimum maximum type name)) { if(exists $options_hash{$param}) { my $newparam = $param; $newparam = $map{$param} if exists $map{$param}; push @options, "--$newparam", "$dsname:$options_hash{$param}"; } } my $rc = $self->RRDs_execute("tune", $self->{file}, @options); # This might impact the default dsname, rediscover $self->meta_data_discover(); return $rc; } ################################################# sub default { ################################################# my($self, $param) = @_; if($param eq "cfunc") { my $cfuncs = $self->meta_data("cfuncs"); return undef unless $cfuncs; # Return the first of all defined consolidation functions return $cfuncs->[0]; } if($param eq "dsname") { my $dsnames = $self->meta_data("dsnames"); return undef unless $dsnames; # Return the first of all defined data sources return $dsnames->[0]; } return undef; } ################################################# sub meta_data { ################################################# my($self, $field, $value, $unique_push) = @_; if(defined $value) { $self->{meta}->{discovered} = 1; } if(!$self->{meta}->{discovered}) { $self->meta_data_discover(); } if(defined $value) { if($unique_push) { push @{$self->{meta}->{$field}}, $value unless $self->{meta}->{"${field}_hash"}->{$value}++; } else { $self->{meta}->{$field} = $value; } } return $self->{meta}->{$field}; } ################################################# sub meta_data_discover { ################################################# my($self) = @_; #========================================== # rrdtoo info output #========================================== #filename = "myrrdfile.rrd" #rrd_version = "0001" #step = 1 #last_update = 1084773097 #ds[mydatasource].type = "GAUGE" #ds[mydatasource].minimal_heartbeat = 2 #ds[mydatasource].min = NaN #ds[mydatasource].max = NaN #ds[mydatasource].last_ds = "UNKN" #ds[mydatasource].value = 0.0000000000e+00 #ds[mydatasource].unknown_sec = 0 #rra[0].cf = "MAX" #rra[0].rows = 5 #rra[0].pdp_per_row = 1 #rra[0].xff = 5.0000000000e-01 #rra[0].cdp_prep[0].value = NaN #rra[0].cdp_prep[0].unknown_datapoints = 0 # Nuke everything delete $self->{meta}; my $hashref = $self->RRDs_execute("info", $self->{file}); foreach my $key (keys %$hashref){ if($key =~ /^rra\[\d+\]\.cf/) { DEBUG "rrdinfo: rra found: $key"; $self->meta_data("cfuncs", $hashref->{$key}, 1); next; } elsif ($key =~ /^ds\[(.*?)]\./) { DEBUG "rrdinfo: da found: $key"; $self->meta_data("dsnames", $1, 1); next; } else { DEBUG "rrdinfo: no match: $key"; } } DEBUG "Discovery: cfuncs=(@{$self->{meta}->{cfuncs}}) ", "dsnames=(@{$self->{meta}->{dsnames}})"; $self->{meta}->{discovered} = 1; } ################################################# sub info_aux { ################################################# my($self) = @_; return $self->RRDs_execute("info", $self->{file}); } ################################################# sub info { ################################################# my($self) = @_; my $hashref = $self->info_aux(); # Returns something like # {'rra[0].rows' => 5, # 'rra[1].pdp_per_row' => 5, # 'last_update' => 1080462600, # 'rra[0].cf' => 'MAX', # 'step' => 60, # 'rra[1].cdp_prep[0].value' => undef, # 'rra[0].cdp_prep[0].unknown_datapoints' => 0, # ... # } # Parse it into a Perl array/hash hierarchy: my $h = {}; for my $key (keys %$hashref) { my $ptr = \$h; while($key =~ /\G(?:\.?(\w+)|\[(\d+)\]|\[(.*?)\])/g) { $ptr = $1 ? \$$ptr->{$1} : defined $2 ? \$$ptr->[$2] : \$$ptr->{$3}; } $$ptr = $hashref->{$key}; } return $h; } ################################################# sub last { ################################################# my($self) = @_; $self->RRDs_execute("last", $self->{file}); } ########################################### sub process_draw { ########################################### my($self, $p, $options, $options_hash, $draw_count) = @_; $self->check_options("graph/draw", [%$p]); $p->{thickness} ||= 1; # LINE1 is default $p->{color} ||= 'FF0000'; # red is default $p->{legend} ||= ''; # no legend by default $p->{file} = first_def $p->{file}, $self->{file}; my($dsname, $cfunc); if($p->{file} ne $self->{file}) { my $rrd = __PACKAGE__->new(file => $p->{file}); $dsname = $rrd->default('dsname'); $cfunc = $rrd->default('cfunc'); } unless(defined $p->{name}) { $p->{name} = "draw$draw_count"; } # Is it just a CDEF, a different view of a another draw? if($p->{cdef}) { push @$options, "CDEF:$p->{name}=$p->{cdef}"; } elsif($p->{vdef}) { push @$options, "VDEF:$p->{name}=$p->{vdef}"; } else { # Use either directly defined, default for a given file or # default for default file, in this order. $p->{dsname} = first_def $p->{dsname}, $dsname, $options_hash->{dsname}; $p->{cfunc} = first_def $p->{cfunc}, $cfunc, $options_hash->{cfunc}; # Create the draw strings # DEF:vname=rrdfile:ds-name:CF[:step=step][:start=time][:end=time] my $def = "DEF:$p->{name}=$p->{file}:$p->{dsname}:$p->{cfunc}"; map { $def .= ":$_=$p->{$_}" } grep { defined $p->{$_} } qw(step start end); push @$options, $def; } #LINE2:myload#FF0000 $p->{type} ||= 'line'; my $draw_attributes = ":$p->{name}#$p->{color}"; if( length $p->{legend} ) { $draw_attributes .= ":$p->{legend}"; } elsif( exists $p->{stack} ) { $draw_attributes .= ":"; } $draw_attributes .= ":STACK" if exists $p->{stack}; if($p->{type} eq "hidden") { # Invisible graph } elsif($p->{type} eq "line") { push @$options, "LINE$p->{thickness}$draw_attributes"; } elsif($p->{type} eq "area") { push @$options, "AREA$draw_attributes"; } elsif($p->{type} eq "stack") { if( ! length $p->{legend} ) { $draw_attributes .= ":"; } # modified for backwards compatibility push @$options, "AREA$draw_attributes:STACK"; } else { die "Invalid graph type: $p->{type}"; } } ########################################### sub process_vrule { ########################################### my($self, $vrule, $options) = @_; # Push vrules $vrule->[1]->{color} ||= "#000000"; push @$options, uc($vrule->[0]) . ":" . $vrule->[1]->{time} . $vrule->[1]->{color} . ( $vrule->[1]->{legend} ? ":" . $vrule->[1]->{legend} : ""); } ########################################### sub process_hrule { ########################################### my($self, $hrule, $options) = @_; # Push hrules $hrule->[1]->{color} ||= "#000000"; push @$options, uc($hrule->[0]) . ":" . $hrule->[1]->{value} . $hrule->[1]->{color} . ( $hrule->[1]->{legend} ? ":" . $hrule->[1]->{legend} : ""); } ########################################### sub process_print { ########################################### my($self, $p, $options, $draws) = @_; if ( $p->[0] eq 'comment' ) { push @$options, uc($p->[0]) . ":" . $p->[1]; } elsif( $p->[0] =~ /^(line)|(area)$/ ) { push @$options, uc($p->[0]) . ($p->[1]->{width} || "") . ":" . $p->[1]->{value} . ($p->[1]->{color} || "") . ($p->[1]->{legend} ? ":$p->[1]->{legend}" : "") . ($p->[1]->{stack} ? ":STACK" : ""); } elsif( $p->[0] eq "tick" ) { push @$options, uc($p->[0]) . ":" . ($p->[1]->{draw} || $draws->[0]->{name}) . ($p->[1]->{color} || '#ff0000') . ($p->[1]->{fraction} ? ":$p->[1]->{fraction}" : ":.1") . ($p->[1]->{legend} ? ":$p->[1]->{legend}" : ""); } elsif( $p->[0] eq "shift" ) { push @$options, uc($p->[0]) . ":" . ($p->[1]->{draw} || $draws->[0]->{name}) . ":$p->[1]->{offset}"; } else { $p->[1]->{draw} ||= $draws->[0]->{name}; $p->[1]->{format} ||= "Average=%lf"; push @$options, uc($p->[0]) . ":" . $p->[1]->{draw} . ":" . ($p->[1]->{cfunc} ? "$p->[1]->{cfunc}:" : "") . $p->[1]->{format}; } } ################################################# sub xport { ################################################# my ($this, @options) = @_; my $sname = "xport"; my $section = $OPTIONS->{$sname}; DEBUG(sub { Dumper($OPTIONS) }); DEBUG(sub { Dumper($section) }); $this->check_options($sname, \@options); $this->print_results([]); my %options = @options; my $ref; my @cmd; # If it's a DateTime object, handle it gracefully foreach (qw(start end)) { next unless exists($options{$_}); next unless defined($options{$_}); if (ref($options{$_}) eq "DateTime") { $options{$_} = $options{$_}->epoch(); } } my @all_options = (@{$section->{optional}}, @{$section->{mandatory}}); foreach my $opt (@all_options) { DEBUG("Processing optional option '$opt'"); if (defined($options{$opt}) and not ref($options{$opt})) { push(@cmd, "--$opt", $options{$opt}); DEBUG("[xport] Pushed option '--$opt' with value '$options{$opt}'"); } } undef(@all_options); my %params = ( def => [], cdef => [], xport => [], ); my $string; foreach my $sec (keys(%params)) { next unless (defined($options{$sec})); LOGDIE("$sec section must be an array ref") unless (ref($options{$sec}) eq "ARRAY"); foreach my $opts (@{$options{$sec}}) { LOGDIE("$sec/$opts section must be a hash ref") unless (ref($opts) eq "HASH"); my @opts = %$opts; $this->check_options("$sname/$sec", \@opts); my $array = $params{$sec}; # DEF if ($sec =~ /^def$/i) { $string = "DEF:"; $string .= "$opts->{vname}="; $string .= "$opts->{file}:"; $string .= "$opts->{dsname}:"; $string .= $opts->{cfunc}; push(@$array, $string); DEBUG("[xport] Pushed DEF '$string'"); } # CDEF elsif ($sec =~ /^cdef$/i) { $string = "CDEF:"; $string .= "$opts->{vname}="; $string .= $opts->{rpn}; push(@$array, $string); DEBUG("[xport] Pushed CDEF '$string'"); } # XPORT else { $string = "XPORT:"; $string .= $opts->{vname}; $string .= ":$opts->{legend}" if defined($opts->{legend}); push(@$array, $string); DEBUG("[xport] Pushed XPORT '$string'"); } } } # Order matters ! foreach my $sec (qw(def cdef xport)) { push(@cmd, @{$params{$sec}}) if (defined($params{$sec}) and scalar @{$params{$sec}} != 0); } DEBUG("[xport] RRDs command: ".join(" ", @cmd)); my @results = $this->RRDs_execute($sname, @cmd); LOGDIE("RRDs::xport() failed") unless (scalar @results > 0); my %meta_data = ( start => $results[0], # Exactly start+step end => $results[1], step => $results[2], columns => $results[3], legend => $results[4], ); my $time = $meta_data{start}; my @data; foreach my $data (@{$results[5]}) { push(@data, [$time, @$data]); $time += $meta_data{step}; } $meta_data{rows} = scalar @data; my $results = { meta => \%meta_data, data => \@data, }; return $this->print_results($results); } ########################################## sub def_or($$) { ########################################### if(! defined $_[0]) { $_[0] = $_[1]; } } 1; __END__ =head1 NAME RRDTool::OO - Object-oriented interface to RRDTool =head1 SYNOPSIS use RRDTool::OO; # Constructor my $rrd = RRDTool::OO->new( file => "myrrdfile.rrd" ); # Create a round-robin database $rrd->create( step => 1, # one-second intervals data_source => { name => "mydatasource", type => "GAUGE" }, archive => { rows => 5 }); # Update RRD with sample values, use current time. for(1..5) { $rrd->update($_); sleep(1); } # Start fetching values from one day back, # but skip undefined ones first $rrd->fetch_start(); $rrd->fetch_skip_undef(); # Fetch stored values while(my($time, $value) = $rrd->fetch_next()) { print "$time: ", defined $value ? $value : "[undef]", "\n"; } # Draw a graph in a PNG image $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => time() - 10, draw => { type => "area", color => '0000FF', legend => "Salary over Time", } ); # Same using rrdtool's graphv $rrd->graphv( image => "mygraph.png", [...] }; =head1 DESCRIPTION =for html C is an object-oriented interface to Tobi Oetiker's round robin database tool I. It uses I's C module to get access to I's shared library. C tries to marry I's database engine with the dwimminess and whipuptitude Perl programmers take for granted. Using C abstracts away implementation details of the RRD engine, uses easy to memorize named parameters and sets meaningful defaults for parameters not needed in simple cases. For the experienced user, however, it provides full access to I's API (if you find a feature that's not implemented, let me know). =head2 FUNCTIONS =over 4 =item Inew( file =E $file )> The constructor hooks up with an existing RRD database file C<$file>, but doesn't create a new one if none exists. That's what the C methode is for. Returns a C object, which can be used to get access to the following methods. =item I<$rrd-Ecreate( ... )> Creates a new round robin database (RRD). A RRD consists of one or more data sources and one or more archives: $rrd->create( step => 60, data_source => { name => "mydatasource", type => "GAUGE" }, archive => { rows => 5 }); This defines a RRD database with a step rate of 60 seconds in between primary data points. Additionally, the RRD start time can be specified by specifying a C parameter. It also sets up one data source named C of type C, telling I to use values of data samples as-is, without additional trickery. And it creates a single archive with a 1:1 mapping between primary data points and archive points, with a capacity to hold five data points. The RRD's C parameter is optional, and will be set to 300 seconds by I by default. In addition to the mandatory settings for C and C, C parameter takes the following optional parameters: C (minimum input, defaults to C), C (maximum input, defaults to C), C (defaults to twice the RRD's step rate). Archives expect at least one parameter, C indicating the number of data points the archive is configured to hold. If nothing else is set, I will store primary data points 1:1 in the archive. If you want to combine several primary data points into one archive point, specify values for C (the number of points to combine) and C (the consolidation function) explicitly: $rrd->create( step => 60, data_source => { name => "mydatasource", type => "GAUGE" }, archive => { rows => 5, cpoints => 10, cfunc => 'AVERAGE', }); This will collect 10 data points to form one archive point, using the calculated average, as indicated by the parameter C (Consolidation Function, CF). Other options for C are C, C, and C. If you're defining multiple data sources or multiple archives, just provide them in this manner: # Define the RRD my $rc = $rrd->create( step => 60, data_source => { name => 'load1', type => 'GAUGE', }, data_source => { name => 'load2', type => 'GAUGE', }, archive => { rows => 5, cpoints => 10, cfunc => 'AVERAGE', }, archive => { rows => 5, cpoints => 10, cfunc => 'MAX', }, ); =item I<$rrd-Eupdate( ... ) > Update the round robin database with a new data sample, consisting of a value and an optional time stamp. If called with a single parameter, like in $rrd->update($value); then the current timestamp and the defined C<$value> will be used. If C is called with a named parameter list like in $rrd->update(time => $time, value => $value); then the given timestamp C<$time> is used along with the given value C<$value>. When updating multiple data sources, use the C parameter (instead of C) and pass an arrayref: $rrd->update(time => $time, values => [$val1, $val2, ...]); This way, I expects you to pass in the data values in exactly the same order as the data sources were defined in the C method. If that's not the case, then the C parameter also accepts a hashref, mapping data source names to values: $rrd->update(time => $time, values => { $dsname1 => $val1, $dsname2 => $val2, ...}); C will transform this automagically into C I