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.
+Runnion on $RRDs::VERSION;
+
+RRDtool update performance is ultimately disk-bound. Since very little data
+does actually get written to disk in a single update, the performance
+is highly dependent on the cache situation in your machine.
+
+This test tries to cater for this. It works like this:
+
+1) Create 100 RRD files (and sync them to disk)
+
+2) Update the 100 RRD file three times in a row.
+ We run the Update several times to see the difference
+ it makes in the cache.
+
+3) Go back to 1)
NOTE
use strict;
use Time::HiRes qw(time);
use RRDs;
+use IO::File;
+use Time::HiRes qw( usleep );
-sub create($){
+sub create($$){
my $file = shift;
- my $start = int(time);
- RRDs::create ( $file.".rrd", qw(
- -s300
+ my $time = shift;
+ my $start = time; #since we loaded HiRes
+ RRDs::create ( $file.".rrd", "-b$time", qw(
+ -s300
DS:in:GAUGE:400:U:U
DS:out:GAUGE:400:U:U
RRA:AVERAGE:0.5:1:600
sub update($$){
my $file = shift;
my $time = shift;
- my $in = int(rand(1000));
- my $out = int(rand(1000));
+ my $in = rand(1000);
+ my $out = rand(1000);
+ my $start = time;
+ my $ret = RRDs::updatev($file.".rrd", $time.":$in:$out");
+# print join("",map {" $_ " . $ret->{$_}."\n" } grep /AVERAGE.\[1\]/, sort keys %$ret)."\n** $time\n\n";
+ # sync updates to disk immediately
+# usleep(1) if (rand(3) <1 );
+ my $total = time - $start;
+ my $error = RRDs::error;
+ die $error if $error;
+ return $total;
+}
+
+sub tune($){
+ my $file = shift;
my $start = time;
- RRDs::update ($file.".rrd", $time.":$in:$out");
+ RRDs::tune ($file.".rrd", "-a","in:U","-a","out:U","-d","in:GAUGE","-d","out:GAUGE");
+ my $total = time - $start;
+ my $error = RRDs::error;
+ die $error if $error;
+ return $total;
+}
+
+sub infofetch($){
+ my $file = shift;
+ my $start = time;
+ my $info = RRDs::info ($file.".rrd");
+ my $error = RRDs::error;
+ die $error if $error;
+ my $lasttime = $info->{last_update} - $info->{last_update} % $info->{step};
+ my $fetch = RRDs::fetch ($file.".rrd",'AVERAGE','-s',$lasttime-1,'-e',$lasttime);
my $total = time - $start;
my $error = RRDs::error;
die $error if $error;
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";
+sub makerrds($$$$){
+ my $count = shift;
+ my $total = shift;
+ my $list = shift;
+ my $time = shift;
+ my @files;
+ for (1..$count){
+ my $id = sprintf ("%07d",$total);
+ $id =~ s/^(.)(.)(.)(.)(.)//;
+ push @$list, "$1/$2/$3/$4/$5/$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++;
+ -d "$1/$2/$3/$4/$5" or mkdir "$1/$2/$3/$4/$5";
+ push @files, $list->[$total];
+ create $list->[$total++],$time-2;
+ print STDERR ".";
}
- 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++;
+ for (@files){
+ my $fd = new IO::File("$_.rrd","r");
+ if (defined $fd) {
+ $fd->sync;
+ $fd->close;
+ } else {
+ warn "failed to sync $_\n";
+ }
+ }
+ return $count;
+}
+
+
+sub main (){
+ mkdir "db-$$" or die $!;
+ chdir "db-$$";
+
+ my $step = 100000; # number of rrds to creat for every round
+
+ my @path;
+ my $time=int(time);
+
+ my $tracksize = 0;
+ my $uppntr = 0;
+
+
+ my %squaresum = ( cr => 0, up => 0 );
+ my %sum = ( cr => 0, up => 0 );
+ my %count =( cr => 0, up => 0 );
+
+ my $printtime = time;
+ while (1) {
+ # enhance the track
+ $time += 300;
+ $tracksize += makerrds $step,$tracksize,\@path,$time;
+ # run benchmark
+ for (0..10){
+ $time += 300;
+ my $count = 0;
+ my $sum = 0;
+ my $squaresum = 0;
+ for (my $i = 0; $i<$tracksize;$i ++){
+ my $elapsed = update($path[$i],$time);
+ $sum += $elapsed;
+ $squaresum += $elapsed**2;
+ $count++;
+ };
+# for (my $i = 0; $i<$tracksize;$i ++){
+# my $fh = new IO::File "$path[$i].rrd","r";
+# if (defined $fh) {
+# $fh->sync;
+# $fh->close;
+# } else {
+# warn "failed to sync $path[$i]\n";
+# }
+# }
+ my $ups = $count/$sum;
+ my $sdv = stddev($sum,$squaresum,$count);
+ printf STDERR "%4d %6.0f Up/s (%6.5f sdv)\n",$count,$ups,$sdv;
}
- $time += 300;
- last if time - $now > 5; # stop testing after 5 seconds or one round
+ print STDERR "\n";
+ exit ;
}
- 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;
}
+
+main;