X-Git-Url: https://git.octo.it/?p=rrdtool.git;a=blobdiff_plain;f=examples%2Fperftest.pl.in;fp=examples%2Fperftest.pl.in;h=f7907c25be3914fd37505ab7a0d56c728afe7862;hp=0000000000000000000000000000000000000000;hb=43576b330db3c4e4dafb93703e28595f1417b337;hpb=48d52cbd1c58cd663f18e3b4ef0c78bccaf22ee0

diff --git a/examples/perftest.pl.in b/examples/perftest.pl.in
new file mode 100755
index 0000000..f7907c2
--- /dev/null
+++ b/examples/perftest.pl.in
@@ -0,0 +1,152 @@
+#! @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;
+}