#! @PERL@
#
# $Id:$
#
# Created By Tobi Oetiker <tobi@oetiker.ch>
# Date 2006-10-27
#
#makes programm work AFTER install

use lib qw( @prefix@/lib/perl );

print <<NOTE;

RRDtool Performance Tester
--------------------------
This Program will create an increassing number of rrds and update them.
The rrds are modeld after what mrtg would create. The Program
will report the number of updates that can be performed per second.
Since rrdtool update performance is helped greatly by the disk cache,
you will observe a sharp drop in performance once the cache is
exhausted. The program tries to detect this change and stop running.

NOTE

use strict;
use Time::HiRes qw(time);
use RRDs;

sub create($){
  my $file = shift;
  my $start = time;
  RRDs::create  ( $file.".rrd", qw(
			-s300
		        DS:in:GAUGE:400:U:U
		        DS:out:GAUGE:400:U:U
		        RRA:AVERAGE:0.5:1:600
		        RRA:AVERAGE:0.5:6:600
		        RRA:MAX:0.5:6:600
		        RRA:AVERAGE:0.5:24:600
		        RRA:MAX:0.5:24:600
		        RRA:AVERAGE:0.5:144:600
		        RRA:MAX:0.5:144:600
		));
   my $total = time - $start;
   my $error =  RRDs::error;
   die $error if $error;
   return $total;
}

sub update($$){
  my $file = shift;
  my $time = shift;
  my $in = int(rand(1000));
  my $out = int(rand(1000));
  my $start = time;
  RRDs::update ($file.".rrd", $time.":$in:$out");
  my $total = time - $start;
  my $error =  RRDs::error;
  die $error if $error;
  return $total;
}

sub stddev ($$$){ #http://en.wikipedia.org/wiki/Standard_deviation
  my $sum = shift;
  my $squaresum = shift;
  my $count = shift;
  return sqrt( 1 / $count * ( $squaresum - $sum*$sum / $count ))
}

mkdir "db-$$" or die $!;
chdir "db-$$";

my $totaldbs=10;
my $createddbs=0;
my %path;
my $time=time;
my $prevups;
my $over = 0;

while (1) {

    # create ###############################################################
    my $squaresum=0;
    my $sum=0;
    my $count=0;

    for(my $db=$createddbs;$db<$totaldbs;$db++){
        # make sure we do not get bitten by
        # expensive directory searches
        # store 100 rrds per directory.
        my $id = sprintf ("%06d",$db);
        $id =~ s/^(.)(.)(.)(.)//;
        $path{$db}="$1/$2/$3/$4/$id";    
        -d "$1" or mkdir "$1";
        -d "$1/$2" or mkdir "$1/$2";
        -d "$1/$2/$3" or mkdir "$1/$2/$3";
        -d "$1/$2/$3/$4" or mkdir "$1/$2/$3/$4";

        $createddbs=$db+1;

        my $total = create $path{$db};
        $sum += $total;
        $squaresum += $total*$total;
        $count++;
    }
    printf STDERR "Create %6d rrds %6d c/s (%6.5f sdv)",$count,$count/$sum,stddev($sum,$squaresum,$count);
  
    # update #################################################################

   $squaresum=0;
   $sum=0;
   $count=0;
   my $now = time;
   while(1){
       for(my $db=0;$db<$totaldbs;$db++){
           my $total = update($path{$db},$time);
           $sum += $total;
           $squaresum += $total*$total;
           $count++;
        }
        $time += 300;
        last if time - $now > 5; # stop testing after 5 seconds or one round
    }
    my $ups = $count/$sum;
    my $sdv = stddev($sum,$squaresum,$count);
    printf STDERR "   Update %6d rrds  %6d u/s (%6.5f sdv)\n",$totaldbs,$ups,$sdv;    
  
    if ((not $prevups or $prevups / $ups < 2 or $totaldbs < 500 )and $over < 1){
       $totaldbs *= 2;
    } elsif ( $over < 1 ) {
       # just run another round to see if we realy hit the block
       $over ++;
       $totaldbs *= 1.3;
    } else {
       print <<NOTE;
       
* Stopping test since your system seems to have hit the cache barrier.

* You may want to run the test repeatedly to be sure that
  your system has not been busy with something other than
  this test.

* If you increas the number of rrd files above the cache barrier,
  the perfomance penalty should be linear.

* Remove the test tree in db-$$

NOTE
       exit;
   }
   $prevups = $ups;
}