rrdflushcached: Do not free 'opt_daemon' before checking the connection. -- Sebastian...
[rrdtool.git] / examples / perftest.pl.in
index f7907c2..022a954 100755 (executable)
@@ -7,30 +7,53 @@
 #
 #makes programm work AFTER install
 
-use lib qw( @prefix@/lib/perl );
+my $Chunk = shift @ARGV || 10000;
+
+use lib qw( ../bindings/perl-shared/blib/lib ../bindings/perl-shared/blib/arch @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.
+Running 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 of your machine.
+
+This test tries to cater for this. It works like this:
+
+1) Create $Chunk RRD files in a tree
+
+2) For $Chunk -> Update RRD file, Sync
+
+3) goto 1)
+
+The numbers at the start of the row, show which
+RRA is being updated. So if several RRAs are being updated,
+you should see a slowdown as data has to be read from disk.
+
+The growning number in the second column shows how many RRD have been
+updated ... If everything is in cache, the number will Jump to $Chunk almost
+immediately. Then the system will seem to hang as 'sync' runs, to make sure
+all data has been written to disk prior to the next perftest run. This may
+not be 100% real-life, so you may want to remove the sync just for fun
+(then it is even less real-life, but different)
 
 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 = 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
@@ -50,10 +73,34 @@ sub create($){
 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");
+  my $total = time - $start;
+  my $error =  RRDs::error;
+  die $error if $error;
+  return $total;
+}
+
+sub tune($){
+  my $file = shift;
+  my $start = time;
+  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;
-  RRDs::update ($file.".rrd", $time.":$in:$out");
+  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;
@@ -67,86 +114,101 @@ sub stddev ($$$){ #http://en.wikipedia.org/wiki/Standard_deviation
   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;
+    my $now = int(time);
+    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++;
-    }
-    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++;
+        -d "$1/$2/$3/$4/$5" or mkdir "$1/$2/$3/$4/$5";
+       push @files, $list->[$total];
+        create $list->[$total++],$time-2;
+       if ($now < int(time)){
+         $now = int(time);
+         print STDERR "Creating RRDs: ", $count - $_," rrds to go. \r";
         }
+    }
+    return $count;
+}
+sub main (){
+    mkdir "db-$$" or die $!;
+    chdir "db-$$";
+
+    my $step = $Chunk; # 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;
+    my %step;
+    for (qw(1 6 24 144)){
+          $step{$_} = int($time / 300 / $_);
+    }
+    
+    for (0..2) {
+        # enhance the track
         $time += 300;
-        last if time - $now > 5; # stop testing after 5 seconds or one round
+        $tracksize += makerrds $step,$tracksize,\@path,$time;            
+        # run benchmark
+    
+        for (0..50){
+           $time += 300;
+            my $count = 0;
+            my $sum = 0;
+            my $squaresum = 0;
+            my $prefix = "";
+            for (qw(1 6 24 144)){
+                if (int($time / 300 / $_) > $step{$_})  {
+                    $prefix .= "$_  ";
+                    $step{$_} = int($time / 300 / $_);
+                 }
+                 else {
+                    $prefix .= (" " x length("$_")) . "  ";
+                 }   
+            }
+            my $now = int(time);
+            for (my $i = 0; $i<$tracksize;$i ++){
+               my $ntime = int(time);
+               if ($now < $ntime or $i == $tracksize){
+                   printf STDERR "$prefix %7d \r",$i;
+                   $now = $ntime;
+               }
+               my $elapsed = update($path[$i],$time);                
+               $sum += $elapsed;
+               $squaresum += $elapsed**2;
+               $count++;
+            };
+            my $startsync = time;
+            print STDERR 's';
+            system "sync";
+            print STDERR "\h";
+            my $synctime = time-$startsync;     
+            $sum += $synctime;
+            $squaresum += $synctime**2;
+            my $ups = $count/$sum;
+            my $sdv = stddev($sum,$squaresum,$count);
+            printf STDERR "$prefix %7d %6.0f Up/s (%6.5f sdv)\n",$count,$ups,$sdv;
+        }
+       print STDERR "\n";
     }
-    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;