RRDTool-OO-0.36/0000755000175000017500000000000012524566640013446 5ustar mschillimschilliRRDTool-OO-0.36/Makefile.PL0000644000175000017500000000623512332352234015413 0ustar mschillimschilliuse 5.006; use ExtUtils::MakeMaker; use File::Basename; my $meta_merge = { META_MERGE => { resources => { repository => 'http://github.com/mschilli/rrdtool-oo-perl', }, } }; # Check if RRDs is installed eval "use RRDs 1.2011"; # (1) libcgi is missing on most Linux/FreeBSD systems, and we # don't need it anyway. # (2) as of rrdtool-1.2.11, tcl libs didn't compile, so let's # leave them out. my $CONFIGURE_OPTS = "--enable-perl-site-install --prefix=/usr --disable-tcl --disable-rrdcgi"; my $DIST_URL = "http://oss.oetiker.ch/rrdtool/pub/rrdtool.tar.gz"; if($@) { print < != 0) { die "\nYou need to be root to do this.\n"; } eval { install_RRDs() }; if($@) { print $@; note(); exit 0; } } else { note(); exit 0; } } # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'RRDTool::OO', VERSION_FROM => 'lib/RRDTool/OO.pm', # finds $VERSION PREREQ_PM => { Log::Log4perl => '0.40', RRDs => 0, Storable => 0, }, # e.g., Module::Name => 1.1 $ExtUtils::MakeMaker::VERSION >= 6.50 ? (%$meta_merge) : (), ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/RRDTool/OO.pm', # retrieve abstract from module AUTHOR => 'Mike Schilli ') : ()), ); ################################################################## sub install_RRDs { ################################################################## require LWP::Simple; print STDERR "Downloading ... "; LWP::Simple::getstore($DIST_URL, basename($DIST_URL)) or die "Cannot download $DIST_URL ($!)"; print STDERR "done.\n"; system("gzip -dc rrdtool.tar.gz | tar xfv -; cd `ls -t | grep rrdtool | grep -v gz | head -1`; ./configure $CONFIGURE_OPTS; make; cd bindings/perl-shared; perl Makefile.PL; make; make test; make install") and die "Install failed: $!"; } ################################################################## sub note { ################################################################## print "################################################\n"; print "# Please check the INSTALLATION section in the #\n"; print "# RRDTool::OO manual page. #\n"; print "# You can download the rrdtool library at #\n"; print "# $DIST_URL\n"; print "# and compile it using #\n"; print "# configure $CONFIGURE_OPTS\n"; print "# make\n"; print "# cd perl-shared; perl Makefile.PL; make install\n"; print "################################################\n"; } RRDTool-OO-0.36/Changes0000644000175000017500000001606012524566570014746 0ustar mschillimschilli0.36 (05/12/2015) (ms) Gelu Lupa added RRD's first() function. 0.35 (07/20/2014) (ms) Fix for [rt.cpan.org #97322], now rounding results to cope with floating point inaccuracies in rrdtool. Reported by Andreas König. 0.34 (06/26/2014) (ms) Added disable_rrdtool_tag option as suggested by Sun Guonian. 0.33 (07/08/2013) (ms) Florian Eckert reported that graph() modified 2nd level entries of the options array passed to it. Used Storable::clone in OO.pm to make a deep copy first. 0.32 (03/06/2012) (ms) [rt.cpan.org #63351] Applied modified patch by Jonas Wagner to fix stacked graphs with no legend. (ms) Implements RRDs::xport and returns a Perl structure instead of basic xport array (Remi Ferrand, Fabien Wernli). 0.31 (05/26/2010) (ms) [rt.cpan.org #54870] Fixed typos/pod errors reported by Salvatore Bonaccorso. (ms) Fixed overwriting input parameters in create(), bug reported by Erik Wasser. 0.30 (02/21/2010) (ms) [RT 53961] Worked around rrdtool-1.3.5 inaccuracy problem by skipping certain tests for rrdtool <= 1.4. 0.29 (02/20/2010) (ms) Added github repository link to Makefile.PL (ms) Fixed documentation for fetch_next(). (ms) [RT 54544] Tom Regner added support for updatev(). 0.28 (11/05/2009) (ms) Applied patch by Lyle Brooks, adding optional step, start, and end parameters to "draw". 0.27 (10/11/2009) (ms) Slaven Rezic reported huge memory consumption by the test suite, turned out to be fetch_start() call spanning several years. Fixed by defining the end time as well as the start time. 0.26 (09/27/2009) (ms) [RT 32601] Using prompt() instead of manually asking for input in Makefile.PL (by Fabien Wernli) (ms) [RT 32046] Calling setlocale() to fix error message check in foreign locales (by Fabien Wernli) (ms) Implemented graphv method. This works just like graph() but uses rrdtool's graphv internally, giving access to additional information using print_results() method (by Fabien Wernli) (ms) Improved RRDs version testing (by Fabien Wernli). 0.25 (04/25/2009) (ms) Applied patch by Christian Dengler, adding the 'hrule' graph parameter and increasing the sleep time in 002Pod.t to two secs to prevent system clock inacurracies from causing test failures. 0.24 (04/02/2009) (ms) Added support for capturing PRINT output as suggested by Peter Mistich. print_output() now returns a ref to an array with the output of the last graph() command's PRINT output. 0.23 (02/05/2009) (ms) update() now accepts DateTime objects as well (suggested by Jay Buffington) (ms) [rt.cpan.org #43011] Fixed rounding error on 64-bit systems reported by Todd E. Rinaldo 0.22 (05/20/2008) (ms) Added aberrant behavior detection (hwpredict) with documentation and test cases. 0.21 (01/23/2008) (ms) Provided backwards compatibility to rrdtool-1.0 for draw/type=stack, which now translates to an area with the :STACK option. 0.20 (01/22/2008) (ms) Bas van der Veen reported that the rrdtool download link changed to http://oss.oetiker.ch/rrdtool/pub/rrdtool.tar.gz, adapted Makefile.PL. (ms) No longer expecting 'Permission denied' to support localized OSes. 0.19 (05/12/2007) (ms) Added 'strict' mode (defaults to true). (ms) Added latest graph parameters from the latest rrdtool release. 0.18 (05/12/2007) (ms) Added 'dry mode' patch by Jacquelin Charbonnel. 0.17 (09/10/2006) (ms) Changed build command in Makefile.PL to adapt to new rrdtool-1.2 directory hierarchy, as suggested by Zac Israel. 0.16 (08/23/2006) (ms) Added 'base' option to graph method, as suggested by Anton Shevchenko. 0.15 (07/23/2006) (ms) Fixed bug with multiple comment lines, of which only the first one was printed in the graph. It was introduced in 0.14. Thanks to Steve van der Burg for reporting and a patch. 0.14 (04/28/2006) (ms) Order of prints, legends, gprints etc. now preserved, see http://lists.ee.ethz.ch/rrd-users/msg11161.html 0.13 (08/07/2005) (ms) Added line, area, tick, and shift to graph method. (ms) Added vdef to graph. (ms) More checks on rrdtool installation, now requiring 1.2.x. 0.12 (07/07/2005) (ms) Steve van der Burg added vrule, comment, and font options (ms) Makefile.PL dependencies version number changed from undef to 0 (ms) Added 'rigid' option to graph. 0.11 (01/05/2005) (ms) Added suggestion by Richard Lippmann to allow for invisible graphs, just used as base for later 'cdef' calculations. Since leaving 'type' out will have RRDTool::OO default to 'line', type => 'hidden' is used to indicate the graph shouldn't be drawn. (ms) Added gprint/print options for graphs 0.10 (11/20/2004) (ms) Added legends to graph() (ms) Maxence Gerbedoen suggested a patch to add 'cdef' functionality. Added slightly differently. 0.09 (10/08/2004) (ms) Fixed bug [cpan #7897]. new() now accepts a raise_error setting. 0.08 (09/24/2004) (ms) Added documentation for multiple data sources and archives. (ms) Martin Kurahaupo added a patch to prevent the test suite from failing when run as root because a test file can't be write-protected. (ms) Chris Fedde provided a patch to structure ::info's output more perl-like. Got input from perlmonks (thanks nobull!) on how to efficiently transform RRDTools info output into Perl data structures. 0.07 (08/15/2004) (ms) doc and test fixes for new rrdtool release 1.0.49. dump() and restore() are now supported. 0.06 (06/21/2004) (ms) added 'start' param in create() docs (ms) JJ Knitis provided a fix for multiple 'color' settings in graph. Added new graph/color syntax. 0.05 (05/26/2004) (ms) added support for dump() and restore(). Test cases in t/007Dump.t will wait until these functions are available in rrdtool, and are skipped until then. (ms) Some graph options don't have parameters, they can specified via option_name => undef now. (ms) Added lower_limit graph option (ms) Added eg/graph.pl as a graph example 0.04 05/22/2004 (ms) added more functionality to graph(), new test cases. (ms) if a graph contains several files, use the defaults from each file (ms) added tune(), info(), last(). dump()/restore() added also, but not activated yet, because not available via RRDs. 0.03 05/18/2004 (ms) fixed discovery of CFs (ms) fixed update with values/hash and added test case 0.02 05/16/2004 (ms) used rrdtool info for meta queries 0.01 05/12/2004 (ms) Where it all began. TODO: * fetch_start/next iterator with saved timestamp, without caching all values RRDTool-OO-0.36/adm/0000755000175000017500000000000012524566640014207 5ustar mschillimschilliRRDTool-OO-0.36/adm/debian-build0000755000175000017500000000034612332352234016444 0ustar mschillimschilli rm -rf debian dh-make-perl --desc 'Object-oriented Perl interface to RRDTool' --email 'Mike Schilli cpan@perlmeister.com' --pkg-perl --arch any --build --depends "librrds-perl,liblog-log4perl-perl" mv ../librrdtool-oo-perl*deb . RRDTool-OO-0.36/eg/0000755000175000017500000000000012524566640014041 5ustar mschillimschilliRRDTool-OO-0.36/eg/dt0000755000175000017500000000417512332352234014372 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.36/eg/graph.pl0000755000175000017500000000431312332352234015470 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.36/MANIFEST.SKIP0000644000175000017500000000015012353200173015322 0ustar mschillimschilliblib ^Makefile$ ^Makefile.old$ CVS .cvsignore docs MANIFEST.bak adm/release .git MYMETA.yml MYMETA.json RRDTool-OO-0.36/META.yml0000664000175000017500000000114112524566640014716 0ustar mschillimschilli--- abstract: 'Object-oriented interface to RRDTool' author: - 'Mike Schilli ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.142690' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: RRDTool-OO no_index: directory: - t - inc requires: Log::Log4perl: '0.40' RRDs: '0' Storable: '0' resources: repository: http://github.com/mschilli/rrdtool-oo-perl version: '0.36' RRDTool-OO-0.36/t/0000755000175000017500000000000012524566640013711 5ustar mschillimschilliRRDTool-OO-0.36/t/005Graph.t0000644000175000017500000004412212332352234015354 0ustar mschillimschilli use Test::More tests => 20; use RRDTool::OO; use Log::Log4perl qw(:easy); $SIG{__WARN__} = sub { use Carp qw(cluck); print cluck(); }; ############################################## # Configuration ############################################## my $VIEW = 0; # Display graphs my $VIEWPROG = "xv"; # using viewprog my $LOGLEVEL = $INFO; # Level of detail ############################################## sub view { return unless $VIEW; system($VIEWPROG, $_[0]) if ( -x $VIEWPROG ); } #Log::Log4perl->easy_init({level => $LOGLEVEL, layout => "%m%n", ## category => 'rrdtool', #file => 'stderr', #layout => '%F{1}-%L: %m%n', #}); my $rrd = RRDTool::OO->new(file => "foo"); ###################################################################### # Create a RRD "foo" ###################################################################### my $start_time = 1080460200; my $nof_iterations = 40; my $end_time = $start_time + $nof_iterations * 60; my $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load1', type => 'GAUGE', heartbeat => 90, min => 0, max => 10.0, }, data_source => { name => 'load2', type => 'GAUGE', heartbeat => 90, min => 0, max => 10.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => 5, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 5, rows => 10, }, archive => { cfunc => 'MIN', xff => '0.5', cpoints => 1, rows => 5, }, archive => { cfunc => 'MIN', xff => '0.5', cpoints => 5, rows => 10, }, ); is($rc, 1, "create ok"); ok(-f "foo", "RRD exists"); for(0..$nof_iterations) { my $time = $start_time + $_ * 60; my $value = sprintf "%.2f", 2 + $_ * 0.1; $rrd->update(time => $time, values => { load1 => $value, load2 => $value+1, }); } $rrd->fetch_start(start => $start_time, end => $end_time, cfunc => 'MAX'); $rrd->fetch_skip_undef(); while(my($time, $val1, $val2) = $rrd->fetch_next()) { last unless defined $val1; DEBUG "$time:$val1:$val2"; } ###################################################################### # Create anoter RRD "bar" ###################################################################### my $rrd2 = RRDTool::OO->new(file => "bar"); $start_time = 1080460200; $nof_iterations = 40; $end_time = $start_time + $nof_iterations * 60; $rc = $rrd2->create( start => $start_time - 10, step => 60, data_source => { name => 'load3', type => 'GAUGE', heartbeat => 90, min => 0, max => 10.0, }, archive => { cfunc => 'AVERAGE', xff => '0.5', cpoints => 5, rows => 10, }, ); is($rc, 1, "create ok"); ok(-f "bar", "RRD exists"); for(0..$nof_iterations) { my $time = $start_time + $_ * 60; my $value = sprintf "%.2f", 10 - $_ * 0.1; $rrd2->update(time => $time, values => { load3 => $value, }); } $rrd2->fetch_start(start => $start_time, end => $end_time, cfunc => 'AVERAGE'); $rrd2->fetch_skip_undef(); while(my($time, $val1) = $rrd2->fetch_next()) { last unless defined $val1; DEBUG "$time:$val1"; } ###################################################################### # Draw simple graph ###################################################################### # Simple line graph $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Draw simple area graph ###################################################################### # Simple line graph $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => "area", color => "00FF00", }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Draw simple stacked graph ###################################################################### # Simple stacked graph $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => "area", color => "00FF00", }, draw => { dsname => "load2", type => "stack", color => "0000FF", }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Draw a graph from two RRD files ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, width => 700, height => 300, draw => { type => "line", thickness => 3, color => '0000ff', dsname => 'load1', cfunc => 'MIN', }, draw => { file => 'bar', type => "line", thickness => 3, color => 'ff0000', # dsname => 'load3', # cfunc => 'AVERAGE', }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Two draws in one graph, one DEF, one CDEF ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'draws and gprints', start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => "line", thickness => 3, color => "00FF00", name => "first", legend => 'firstg', }, gprint => { draw => 'first', cfunc => 'AVERAGE', format => 'Average1=%lf', }, draw => { type => "line", thickness => 3, color => "0000FF", cdef => "first,2,*", name => "second", legend => 'secondg', }, gprint => { draw => 'second', cfunc => 'AVERAGE', format => 'Average2=%lf', }, draw => { type => "line", thickness => 3, color => "0000FF", cdef => "first,3,*", name => "third", legend => 'thirdg', }, gprint => { draw => 'third', cfunc => 'AVERAGE', format => 'Average3=%lf', }, draw => { type => "line", thickness => 3, color => "0000FF", cdef => "first,4,*", }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Test ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'line', color => 'FF0000', # red line name => 'firstgraph', legend => 'Unmodified Load', }, draw => { type => 'line', color => '00FF00', # green line cdef => "firstgraph,2,*", legend => 'Load Doubled Up', }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Test ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'hidden', color => 'FF0000', # red line name => 'firstgraph', legend => 'Unmodified Load', }, draw => { type => 'line', color => '00FF00', # green line cdef => "firstgraph,2,*", legend => 'Load Doubled Up', }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Test gprint ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'Test gprint', start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'line', color => 'FF0000', # red line name => 'firstgraph', legend => 'Unmodified Load', }, draw => { type => 'hidden', name => 'average_of_first_draw', vdef => 'firstgraph,AVERAGE', }, gprint => { draw => 'average_of_first_draw', format => "Hello %lf", }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Test comment, vrule ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'Test comment, vrule', start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'line', color => 'FF0000', # red line name => 'firstgraph', legend => 'Unmodified Load', }, gprint => { draw => 'firstgraph', cfunc => 'AVERAGE', format => 'Average=%lf', }, comment => "Remember, 83% of all statistics are made up", vrule => { time => $start_time + 10 * 60, legend => "vrule1", color => "#ff0000", }, vrule => { time => $start_time + 20 * 60, legend => "vrule2", color => "#00ff00", }, hrule => { value => 2.5, legend => "hrule1", color => "#0000ff", }, hrule => { value => 3.5, legend => "hrule2", color => "#aa00aa", }, # font => { name => "/usr/X11R6/lib/X11/fonts/TTF/VeraBd.ttf", # size => 32, # element => "title", # }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Test line, area ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'Test line, area', width => 1000, start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'line', color => 'FF0000', # red line name => 'firstgraph', legend => 'Unmodified Load', }, line => { value => 3, legend => "line1", color => "#00ff00", stack => 1, }, line => { value => 10, legend => "line2", color => "#ff0000", }, area => { value => 5, legend => "area1", color => "#0000ff", }, tick => { legend => "ticks", color => "#00ff00", fraction => 0.5, }, shift => { draw => 'firstgraph', offset => 1000, }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Test stack compatibility ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'Stack', width => 1000, start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'stack', color => 'FF0000', # red area name => 'firstgraph', legend => 'first', }, draw => { type => 'stack', color => '00FF00', # green area name => 'secondgraph', legend => 'second', }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; ###################################################################### # Test stacks ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'Stack', width => 1000, start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'area', color => 'FF0000', # red area name => 'firstgraph', legend => 'first', stack => 1, }, draw => { type => 'line', color => '00FF00', # green line name => 'secondgraph', legend => 'second', stack => 1, }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; VDEF: ###################################################################### # Test vdef, gprint ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'Test vdef, gprint', width => 1000, start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'line', name => 'firstdraw', legend => 'Unmodified Load', }, draw => { type => 'hidden', name => 'average_of_firstgraph', vdef => 'firstdraw,AVERAGE', }, gprint => { draw => 'average_of_firstgraph', format => 'Average=%lf', }, ); view("mygraph.png"); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; PRINT: ###################################################################### # Test print ###################################################################### $rrd->graph( image => "mygraph.png", vertical_label => 'Test vdef, gprint', width => 1000, start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => 'line', name => 'firstdraw', legend => 'Unmodified Load', }, draw => { type => 'hidden', name => 'average_of_firstgraph', vdef => 'firstdraw,AVERAGE', }, print => { draw => 'average_of_firstgraph', format => "\"Average=%lf\"", }, ); my @prgraph = ( image => "mygraph.png", start => $start_time, end => $start_time + $nof_iterations * 60, draw => { type => "hidden", name => "firstdraw", #cfunc => 'AVERAGE' }, draw => { type => "hidden", color => '00FF00', # green line name => "in95precent", vdef => "firstdraw,95,PERCENT" }, print => { draw => 'in95precent', format => "Result = %3.2lf", }, ); $rrd->graph( @prgraph, ); SKIP: { skip "Skipping potentially buggy RRDs < 1.4 for print/format", 1 if $RRDs::VERSION < 1.4; is($rrd->print_results()->[0], "Result = 6.00", "print result"); } ###################################################################### # Draw simple graphv ###################################################################### SKIP: { eval "use RRDs 1.3"; skip "RRDs is too old: need 1.3 for graphv", 2 if $@; # Simple line graph $rrd->graphv( @prgraph ); ok(-f "mygraph.png", "Image exists"); unlink "mygraph.png"; skip "Skipping potentially buggy RRDs < 1.4 for print/format", 1 if $RRDs::VERSION < 1.4; is($rrd->print_results()->{'print[0]'}, "Result = 6.00", "print result"); } unlink("foo"); unlink("bar"); RRDTool-OO-0.36/t/001Basic.t0000644000175000017500000001423412362665627015351 0ustar mschillimschilli use Test::More qw(no_plan); use RRDTool::OO; use POSIX qw(setlocale LC_ALL); use FindBin qw( $Bin ); require "$Bin/inc/round.t"; use Log::Log4perl qw(:easy); #Log::Log4perl->easy_init({level => $INFO, layout => "%L: %m%n", # category => 'rrdtool', # file => 'stdout'}); my $rrd; my $loc = setlocale( LC_ALL, "C" ); ###################################################################### # constructor missing mandatory parameter eval { $rrd = RRDTool::OO->new(); }; like($@, qr/Mandatory parameter 'file' not set/, "new without file"); # constructor featuring illegal parameter eval { $rrd = RRDTool::OO->new( file => 'file', foobar => 'abc' ); }; like($@, qr/Illegal parameter 'foobar' in new/, "new with illegal parameter"); # Legal constructor $rrd = RRDTool::OO->new( file => 'foo' ); ###################################################################### # create missing everything ###################################################################### eval { $rrd->create(); }; like($@, qr/Mandatory parameter/, "create missing everything"); # create missing data_source eval { $rrd->create( archive => {} ); }; like($@, qr/Mandatory parameter/, "create missing data_source"); # create missing archive eval { $rrd->create( data_source => {} ); }; like($@, qr/No archives/, "create missing archive"); # create with superfluous param eval { $rrd->create( data_source => { name => 'foobar', type => 'foo', # heartbeat => 10, }, archive => { cfunc => 'abc', name => 'archname', xff => '0.5', cpoints => 5, rows => 10, }, ) }; like($@, qr/Illegal parameter 'name'/, "create missing heartbeat"); ###################################################################### # Run the test example in # http://www.linux-magazin.de/Artikel/ausgabe/2004/06/perl/perl.html ###################################################################### my $start_time = 1080460200; my $nof_iterations = 40; my $end_time = $start_time + $nof_iterations * 60; my $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load', type => 'GAUGE', heartbeat => 90, min => 0, max => 10.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => 5, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 5, rows => 10, }, ); is($rc, 1, "create ok"); ok(-f "foo", "RRD exists"); for(0..$nof_iterations) { my $time = $start_time + $_ * 60; my $value = sprintf "%.2f", 2 + $_ * 0.1; $rrd->update(time => $time, value => $value); } # short-term archive my @expected = qw(1080462360:5.6 1080462420:5.7 1080462480:5.8 1080462540:5.9 1080462600:6); $rrd->fetch_start(start => $end_time - 5*60, end => $end_time, cfunc => 'MAX'); $rrd->fetch_skip_undef(); my $count = 0; while(my($time, $val) = $rrd->fetch_next()) { last unless defined $val; # rrdtool has some inaccurracies [rt.cpan.org #97322] $val = roundfloat( $val ); is("$time:$val", shift @expected, "match expected value"); $count++; } is($count, 5, "items found"); # long-term archive @expected = qw(1080461100:3.5 1080461400:4 1080461700:4.5 1080462000:5 1080462300:5.5 1080462600:6); $rrd->fetch_start(start => $end_time - 30*60, end => $end_time, cfunc => 'MAX'); $rrd->fetch_skip_undef(); $count = 0; while(my($time, $val) = $rrd->fetch_next()) { last unless defined $val; # older rrdtool installations show an additional value next if "$time:$val" eq "1080460800:3"; is("$time:$val", shift @expected, "match expected value"); $count++; } is($count, 6, "items found"); ###################################################################### # check info for this rrd ###################################################################### my $info = $rrd->info; is $info->{'ds'}{'load'}{'type'} => 'GAUGE', 'check RRDTool::OO::info'; is $info->{'ds'}{'load'}{'max'} => '10', 'check RRDTool::OO::info'; is $info->{'rra'}['1']{'cf'} => 'MAX', 'check RRDTool::OO::info'; ###################################################################### # Failed update: time went backwards ###################################################################### $rrd->{raise_error} = 0; ok(! $rrd->update(value => 123, time => 123), "update with expired timestamp"); $rrd->{raise_error} = 1; like($rrd->error_message(), qr/illegal attempt to update using time \d+ when last update time is \d+ \(minimum one second step\)/, "check error message"); ###################################################################### # Ok update ###################################################################### ok($rrd->update(value => 123, time => 1080500000), "update with ok timestamp"); ###################################################################### # Check what happens if the rrd is write-protected all of a sudden ###################################################################### SKIP: { chmod 0444, "foo"; skip "can't make test file unwritable (are you root?)", 1 if -w "foo"; eval { $rrd->update(value => 123, time => 1080500100); }; if($@) { ok($@, "update on write-protected rrd"); } else { fail("update on write-protected rrd"); } } ###################################################################### # constructor including raise_error (cpan #7897) $rrd = RRDTool::OO->new(file => "foo1", raise_error => 0); eval { $rrd->update(value => 123, time => 123); }; is($@, "", "Error caught"); $rrd = RRDTool::OO->new(file => "foo1", raise_error => 1); eval { $rrd->update(value => 123, time => 123); }; like($@, qr/No such file or directory/, "Error raised"); END { unlink('foo'); } RRDTool-OO-0.36/t/012Xport.t0000644000175000017500000000665112332352234015432 0ustar mschillimschilli use Test::More qw/no_plan/; use RRDTool::OO; use Log::Log4perl qw(:easy); #Log::Log4perl->easy_init($DEBUG); $SIG{__WARN__} = sub { use Carp qw(cluck); print cluck(); }; ############################################## # Configuration ############################################## my $LOGLEVEL = $INFO; # Level of detail ############################################## my $rrd = RRDTool::OO->new(file => "foo"); ###################################################################### # Create a RRD "foo" ###################################################################### my $start_time = 1080460200; my $step = 60; my $nof_iterations = 40; my $end_time = $start_time + $nof_iterations * $step; my $rc = $rrd->create( start => $start_time - 10, step => $step, data_source => { name => 'load1', type => 'GAUGE', min => 0, max => 10.0, }, data_source => { name => 'load2', type => 'GAUGE', min => 0, max => 10.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => $nof_iterations + 1, }, archive => { cfunc => 'MIN', xff => '0.5', cpoints => 1, rows => $nof_iterations + 1, }, ); is($rc, 1, "create ok"); ok(-f "foo", "RRD exists"); for (0..$nof_iterations) { my $time = $start_time + $_ * $step; my $value = sprintf("%.2f", 2 + $_ * 0.1); $rrd->update(time => $time, values => { load1 => $value, load2 => $value+1, }); } ############################ ## Do some real test here ## ############################ my $results = $rrd->xport( start => $start_time, end => $end_time , step => $step, def => [{ vname => "load1_vname", file => "foo", dsname => "load1", cfunc => "MAX", }, { vname => "load2_vname", file => "foo", dsname => "load2", cfunc => "MIN", }], xport => [{ vname => "load1_vname", legend => "it_gonna_be_legend", }, { vname => "load2_vname", legend => "wait_for_it___dary", }], ); # use Data::Dumper; # open(D, ">", "/tmp/dumper.txt"); # print D Dumper($results), "\n"; # print D "EndTime: $end_time\n"; # print D "StartTime: $start_time\n"; # close(D); ok(defined($results), "RRDs::xport returns something"); my $meta = $results->{meta}; my $data = $results->{data}; my $r_end = $meta->{end} % $end_time; my $r_start = $meta->{start} % $start_time; ok((($r_end == $step) or ($r_end == 0)), "EndTime matches"); ok((($r_start == $step) or ($r_start == 0)), "StartTime matches"); # ok($meta->{rows} == $nof_iterations, "Number of rows matches"); ok(ref($meta->{legend}) eq "ARRAY", "Legend is an ARRAY ref"); ok($meta->{legend}->[0] eq "it_gonna_be_legend", "First legend matches"); ok($meta->{legend}->[1] eq "wait_for_it___dary", "Second legend matches"); # MetaData check ok($meta->{rows} == scalar @$data, "Number of rows matches metadata"); ok($data->[0]->[0] == $meta->{start}, "First data timestamp matches"); ok($data->[-1]->[0] == $meta->{end}, "Last data timestamp matches"); ok($data->[2]->[0] - $data->[1]->[0] == $meta->{step}, "Step is respected between two entries"); # Some cleanup unlink("foo"); RRDTool-OO-0.36/t/008Mult.t0000644000175000017500000000454412362665642015260 0ustar mschillimschilli# Test multiple data sources and multiple archives in one RRD. use Test::More qw(no_plan); use RRDTool::OO; use FindBin qw( $Bin ); require "$Bin/inc/round.t"; use Log::Log4perl qw(:easy); #Log::Log4perl->easy_init({level => $INFO, layout => "%L: %m%n", # category => 'rrdtool', # file => 'stdout'}); my $rrd = RRDTool::OO->new( file => 'foo' ); END { unlink('foo'); } 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', heartbeat => 90, min => 0, max => 100.0, }, data_source => { name => 'load2', type => 'GAUGE', heartbeat => 90, min => 0, max => 100.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => 5, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 5, rows => 10, }, ); is($rc, 1, "create ok"); ok(-f "foo", "RRD exists"); for(0..$nof_iterations) { my $time = $start_time + $_ * 60; my $value = sprintf "%.2f", 2 + $_ * 0.1; $rrd->update(time => $time, values => [$value, $value + 10]); } # short-term archive my @expected_val1 = qw(1080462360:5.6 1080462420:5.7 1080462480:5.8 1080462540:5.9 1080462600:6); my @expected_val2 = qw(1080462360:15.6 1080462420:15.7 1080462480:15.8 1080462540:15.9 1080462600:16); $rrd->fetch_start(start => $end_time - 5*60, end => $end_time, cfunc => 'MAX'); $rrd->fetch_skip_undef(); my $count = 0; while(my($time, $val1, $val2) = $rrd->fetch_next()) { last unless defined $val1; $val1 = roundfloat( $val1 ); is("$time:$val1", shift @expected_val1, "match expected value"); is("$time:$val2", shift @expected_val2, "match expected value"); $count++; } is($count, 5, "items found"); exit 0; RRDTool-OO-0.36/t/003Discover.t0000644000175000017500000000270212332352234016065 0ustar mschillimschilli ########################################### # Test meta data discovery # Mike Schilli, 2004 (m@perlmeister.com) ########################################### use warnings; use strict; use Test::More qw(no_plan); use RRDTool::OO; use Log::Log4perl qw(:easy); #Log::Log4perl->easy_init({ # level => $DEBUG, # layout => "%L: %m%n", # file => 'stdout' #}); my $rrd = RRDTool::OO->new(file => "rrdtooltest.rrd"); # Create a round-robin database $rrd->create( step => 1, # one-second intervals data_source => { name => "mydatasource", type => "GAUGE" }, data_source => { name => "myotherdatasource", type => "GAUGE" }, archive => { rows => 5, cfunc => 'MAX', cpoints => 10, }, archive => { rows => 5, cfunc => 'MIN', cpoints => 10, }, ); # start from scratch with a new object # to the same rrd file $rrd = RRDTool::OO->new(file => "rrdtooltest.rrd"); $rrd->meta_data_discover(); my $dsnames = $rrd->meta_data("dsnames"); my $cfuncs = $rrd->meta_data("cfuncs"); like("@$cfuncs", qr/MAX/, "check cfunc"); like("@$cfuncs", qr/MIN/, "check cfunc"); like("@$dsnames", qr/mydatasource/, "check dsname"); like("@$dsnames", qr/myotherdatasource/, "check dsname"); END { unlink "rrdtooltest.rrd"; } RRDTool-OO-0.36/t/013Clone.t0000644000175000017500000000266612332352234015361 0ustar mschillimschilli use Test::More; use RRDTool::OO; use Log::Log4perl qw(:easy); my $rrd = RRDTool::OO->new( file => "blech.rrd" ); plan tests => 1; my $start_time = 1080460200; my $nof_iterations = 40; my $end_time = $start_time + $nof_iterations * 60; my $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load1', type => 'GAUGE', heartbeat => 90, min => 0, max => 10.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => 5, }, ); my %options = ( image => "mygraph.png", vertical_label => 'Test vdef, gprint', width => 1000, start => 0, end => 1, draw => { type => 'hidden', dsname => 'tx', cfunc => 'MAX', name => 'tx_max', }, gprint => { 'draw' => 'tx_max', 'format' => 'AVERAGE:%5.1lf%s Avg,', }, ); eval { $rrd->graphv( %options ); }; # Don't modify the incoming array (bug reported by Florian Eckert) ok !exists $options{ draw }->{ file }, "no in-depth modification of input array"; # use Data::Dumper; # print Dumper( \@options ); END { unlink "blech.rrd"; } RRDTool-OO-0.36/t/006Tune.t0000644000175000017500000000472312524566467015254 0ustar mschillimschilli use Test::More qw(no_plan); use RRDTool::OO; $| = 1; ################################################### my $LOGLEVEL = $OFF; ################################################### use Log::Log4perl qw(:easy); Log::Log4perl->easy_init({level => $LOGLEVEL, layout => "%L: %m%n", category => 'rrdtool', file => 'stdout'}); my $rrd = RRDTool::OO->new(file => "foo"); # create with superfluous param $rrd->create( data_source => { name => 'foobar', type => 'GAUGE', }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 5, rows => 10, }, ); ok(-e "foo", "RRD exists"); ##################################################### # Change ds type ##################################################### my $hashref = $rrd->info(); is($hashref->{'ds'}{'foobar'}{'type'}, 'GAUGE', 'dstype before tune'); $rrd->tune(dsname => 'foobar', type => "COUNTER"); $hashref = $rrd->info(); is($hashref->{'ds'}{'foobar'}{'type'}, 'COUNTER', 'dstype tuned'); ##################################################### # Change ds name ##################################################### $rrd->tune(name => "newfoobar"); $hashref = $rrd->info(); is($hashref->{'ds'}{'newfoobar'}{'type'}, 'COUNTER', 'dsname tuned'); ##################################################### # Change minimum/maximum ##################################################### $rrd->tune(maximum => 20, minimum => 5); $hashref = $rrd->info(); is($hashref->{'ds'}{'newfoobar'}{'max'}, '20', 'maximum tuned'); is($hashref->{'ds'}{'newfoobar'}{'min'}, '5', 'minimum tuned'); ##################################################### # Change heartbeat ##################################################### is($hashref->{'ds'}{'newfoobar'}{'minimal_heartbeat'}, '600', 'heartbeat before'); $rrd->tune(heartbeat => 200); $hashref = $rrd->info(); is($hashref->{'ds'}{'newfoobar'}{'minimal_heartbeat'}, '200', 'heartbeat tuned'); ##################################################### # Get last update ##################################################### my $time = $rrd->last(); like($time, qr/^\d+$/, 'last update timestamp'); ##################################################### # Get first update ##################################################### my $time = $rrd->first(); like($time, qr/^\d+$/, 'first update timestamp'); END { unlink "foo"; } RRDTool-OO-0.36/t/010ABD.t0000644000175000017500000000562112332352234014676 0ustar mschillimschilli# Test dry run mode in RRDTool::OO use Test::More; use RRDTool::OO; use Log::Log4perl qw(:easy); plan tests => 1; #Log::Log4perl->easy_init({level => $INFO, layout => "%L: %m%n", # category => 'rrdtool', # file => 'stdout'}); # my $rrd = RRDTool::OO->new( file => 'foo', raise_error => 1, ); END { unlink "foo"; } my $start_time = 1080460200; my $nof_iterations = 100; my $end_time = $start_time + $nof_iterations * 60; my $rows = 300; # Define the RRD my $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load1', type => 'GAUGE', heartbeat => 90, min => 0, max => 100.0, }, archive => { rows => $rows, cfunc => "MAX", }, hwpredict => { rows => $rows, alpha => 0.50, beta => 0.50, gamma => 0.01, seasonal_period => 30, threshold => 2, window_length => 9, }, ); my $time = $start_time; my $value = 2; for(0..$nof_iterations) { $time += 60; $value += 0.1; $value = sprintf "%.2f", $value; $rrd->update(time => $time, value => $value); } for(1..10) { $time += 60; $rrd->update(time => $time, value => 0); } for(0..$nof_iterations) { $time += 60; $value += 0.1; $value = sprintf "%.2f", $value; $rrd->update(time => $time, value => $value); } # $rrd->graph( # image => "mygraph.png", # start => $start_time, # end => $time, # draw => { # type => "line", # color => 'FF0000', # cfunc => 'MAX', # legend => 'max', # }, # draw => { # type => "line", # color => '0000FF', # cfunc => 'HWPREDICT', # legend => 'hwpredict', # }, # draw => { # type => "line", # color => '00FF00', # cfunc => 'SEASONAL', # legend => 'seasonal', # }, # draw => { # type => "area", # color => '00eeee', # cfunc => 'FAILURES', # legend => 'error', # }, # ); # #system("xv mygraph.png"); isnt(count_failures($rrd, $start_time), 0, "aberrant behaviour detected"); ########################################### sub count_failures { ########################################### my($rrd, $start_time) = @_; $rrd->fetch_start(start => $start_time, end => $end_time + 3600, cfunc => "FAILURES"); $rrd->fetch_skip_undef(); my $count = 0; while(my($time, $val) = $rrd->fetch_next()) { last unless defined $val; $count++ if $val; } return $count; } RRDTool-OO-0.36/t/inc/0000755000175000017500000000000012524566640014462 5ustar mschillimschilliRRDTool-OO-0.36/t/inc/round.t0000644000175000017500000000026512362664775016011 0ustar mschillimschilli ########################################### sub roundfloat { ########################################### my( $float ) = @_; return ( sprintf "%.3f", $float ) * 1.0; } 1; RRDTool-OO-0.36/t/011Bugs.t0000644000175000017500000000056112332352234015207 0ustar mschillimschilli use Test::More qw(no_plan); use RRDTool::OO; my $aref = [ step => 1, data_source => { name => "mydatasource", type => "GAUGE" }, archive => { rows => 30 } ]; my $rrd = RRDTool::OO->new( file => "foo" ); $rrd->create( @{ $aref } ); ok !exists $aref->[5]->{ cfunc }, "input parameter not overwritten"; unlink "foo"; RRDTool-OO-0.36/t/002Pod.t0000644000175000017500000000426212332352234015033 0ustar mschillimschilli use Test::More qw(no_plan); use RRDTool::OO; use strict; use warnings; my $count = 0; use Log::Log4perl qw(:easy); # Log::Log4perl->easy_init({ # level => $INFO, # category => 'rrdtool', # layout => '%m%n', # }); ### START POD HERE ### # 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", heartbeat => 100, }, archive => { rows => 5 }); ok(1, "Create"); # Update RRD with sample values, use current time. for(1..3) { $rrd->update($_); ok(1, "Update"); sleep(2); } # 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()) { $count++; #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', } ); ### END POD HERE ### # Area graph $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => time() - 10, draw => { type => "area", color => '0000ff', }, ); # Stacked graph $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => time() - 10, draw => { type => "area", color => '0000ff', }, draw => { type => "stack", color => '00ff00', }, ); ok($count > 2, "Fetch"); END { #unlink "mygraph.png"; unlink "myrrdfile.rrd"; } RRDTool-OO-0.36/t/007Dump.t0000644000175000017500000000306212332352234015220 0ustar mschillimschilli use strict; use warnings; use Test::More; use RRDTool::OO; $| = 1; use Log::Log4perl qw(:easy); ################################################### my $LOGLEVEL = $OFF; ################################################### Log::Log4perl->easy_init({level => $LOGLEVEL, layout => "%L: %m%n", category => 'rrdtool', file => 'stderr'}); my $rrd = RRDTool::OO->new(file => "foo"); eval { $SIG{__DIE__} = $SIG{__WARN__} = sub {}; $rrd->dump(); }; if($@ =~ /Can.t locate/) { plan skip_all => "only with RRDs supporting dump/restore"; } else { plan tests => 2; } # create with superfluous param $rrd->create( data_source => { name => 'foobar', type => 'GAUGE', }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 5, rows => 10, }, ); ok(-e "foo", "RRD exists"); my $size = -s "foo"; ##################################################### # Dump it. ##################################################### my $pid; unless ($pid = open DUMP, "-|") { die "Can't fork: $!" unless defined $pid; $rrd->dump(); exit 0; } #print "\$\$ = $$, pid=$pid\n"; waitpid($pid, 0); open OUT, ">out"; print OUT $_ for ; close OUT; unlink "foo"; ##################################################### # Restore it. ##################################################### $rrd->restore("out"); ok(-f "foo", "RRD resurrected"); END { unlink "foo"; unlink "out"; } RRDTool-OO-0.36/t/009Dry.t0000644000175000017500000000670512332352234015062 0ustar mschillimschilli# Test dry run mode in RRDTool::OO use Test::More; use RRDTool::OO; use Log::Log4perl qw(:easy); plan tests => 6; #Log::Log4perl->easy_init({level => $INFO, layout => "%L: %m%n", # category => 'rrdtool', # file => 'stdout'}); my $rrd = RRDTool::OO->new( file => 'foo', dry_run => 1, ); my $start_time = 1080460200; my $nof_iterations = 10; # Define the RRD my $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load1', type => 'GAUGE', heartbeat => 90, min => 0, max => 100.0, }, data_source => { name => 'load2', type => 'GAUGE', heartbeat => 90, min => 0, max => 100.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => 5, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 5, rows => 10, }, ); my($subref, $args, $func) = $rrd->get_exec_env(); is($func, "create", "get_exec_env function"); is("@$args", "foo --start 1080460190 --step 60 DS:load1:GAUGE:90:0:100 DS:load2:GAUGE:90:0:100 RRA:MAX:0.5:1:5 RRA:MAX:0.5:5:10", "dry run arguments"); $rrd = RRDTool::OO->new( file => 'foo', dry_run => 1, strict => 0, ); $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load1', type => 'GAUGE', heartbeat => 90, min => 0, max => 100.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => 5, }, ); # Test non-strict $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, spitzen_sparken => 1, ); ok(1, "survived illegal parameter"); ($subref, $args, $func) = $rrd->get_exec_env(); like("@$args", qr/--spitzen-sparken 1/, "illegal parameter added to rrd cmd"); # Add a new parameter in strict mode $rrd = RRDTool::OO->new( file => 'foo', dry_run => 1, ); $rc = $rrd->create( start => $start_time - 10, step => 60, data_source => { name => 'load1', type => 'GAUGE', heartbeat => 90, min => 0, max => 100.0, }, archive => { cfunc => 'MAX', xff => '0.5', cpoints => 1, rows => 5, }, ); $rrd->option_add("graph", "frobnication_level"); $rrd->graph( image => "mygraph.png", vertical_label => 'My Salary', start => $start_time, end => $start_time + $nof_iterations * 60, frobnication_level => 1, ); ok(1, "survived illegal parameter"); ($subref, $args, $func) = $rrd->get_exec_env(); like("@$args", qr/--frobnication-level 1/, "illegal parameter added to rrd cmd"); RRDTool-OO-0.36/t/004Template.t0000644000175000017500000000305212332352234016062 0ustar mschillimschilli ########################################### # Test meta data discovery # Mike Schilli, 2004 (m@perlmeister.com) ########################################### use warnings; use strict; use Test::More qw(no_plan); use RRDTool::OO; use Log::Log4perl qw(:easy); #Log::Log4perl->easy_init({ # category => 'rrdtool', # level => $INFO, # layout => "%m%n", # file => 'stdout' #}); my $rrd = RRDTool::OO->new(file => "rrdtooltest.rrd"); my $start_time = 1080460200; my $rc = $rrd->create( start => $start_time - 10, step => 1, data_source => { name => 'ds1', type => 'GAUGE', }, data_source => { name => 'ds2', type => 'GAUGE', }, data_source => { name => 'ds3', type => 'GAUGE', }, archive => { cfunc => 'MAX', cpoints => 1, rows => 10, }, ); for(0..10) { my $time = $start_time + $_; $rrd->update( time => $time, values => { "ds1" => 1, "ds2" => 2, "ds3" => 3, }, ); } $rrd->fetch_start(start => $start_time, end => $start_time + 10); $rrd->fetch_skip_undef(); my $count = 0; while(my($time, @val) = $rrd->fetch_next()) { last unless defined $val[0]; like "$time:@val", qr/\d+:1 2 3/, "values in correct order"; $count++; } is($count, 10, "10 items found"); END { unlink "rrdtooltest.rrd"; } RRDTool-OO-0.36/lib/0000755000175000017500000000000012524566640014214 5ustar mschillimschilliRRDTool-OO-0.36/lib/RRDTool/0000755000175000017500000000000012524566640015501 5ustar mschillimschilliRRDTool-OO-0.36/lib/RRDTool/OO.pm0000644000175000017500000022062112524566576016367 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.36'; # 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 disable_rrdtool_tag )], 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)], }, first => { mandatory => [], optional => [], }, 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, first => \&RRDs::first, 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 first { ################################################# my($self) = @_; $self->RRDs_execute("first", $self->{file}); } ################################################# 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