examples/perftest.pl.in

   1 #! @PERL@
   2 #
   3 # $Id:$
   4 #
   5 # Created By Tobi Oetiker <tobi@oetiker.ch>
   6 # Date 2006-10-27
   7 #
   8 #makes programm work AFTER install
   9
  10 use lib qw( @prefix@/lib/perl );
  11
  12 print <<NOTE;
  13
  14 RRDtool Performance Tester
  15 --------------------------
  16 This Program will create an increassing number of rrds and update them.
  17 The rrds are modeld after what mrtg would create. The Program
  18 will report the number of updates that can be performed per second.
  19 Since rrdtool update performance is helped greatly by the disk cache,
  20 you will observe a sharp drop in performance once the cache is
  21 exhausted. The program tries to detect this change and stop running.
  22
  23 NOTE
  24
  25 use strict;
  26 use Time::HiRes qw(time);
  27 use RRDs;
  28
  29 sub create($){
  30   my $file = shift;
  31   my $start = int(time);
  32   RRDs::create  ( $file.".rrd", qw(
  33                         -s300
  34                         DS:in:GAUGE:400:U:U
  35                         DS:out:GAUGE:400:U:U
  36                         RRA:AVERAGE:0.5:1:600
  37                         RRA:AVERAGE:0.5:6:600
  38                         RRA:MAX:0.5:6:600
  39                         RRA:AVERAGE:0.5:24:600
  40                         RRA:MAX:0.5:24:600
  41                         RRA:AVERAGE:0.5:144:600
  42                         RRA:MAX:0.5:144:600
  43                 ));
  44    my $total = time - $start;
  45    my $error =  RRDs::error;
  46    die $error if $error;
  47    return $total;
  48 }
  49
  50 sub update($$){
  51   my $file = shift;
  52   my $time = shift;
  53   my $in = int(rand(1000));
  54   my $out = int(rand(1000));
  55   my $start = time;
  56   RRDs::update ($file.".rrd", $time.":$in:$out");
  57   my $total = time - $start;
  58   my $error =  RRDs::error;
  59   die $error if $error;
  60   return $total;
  61 }
  62
  63 sub stddev ($$$){ #http://en.wikipedia.org/wiki/Standard_deviation
  64   my $sum = shift;
  65   my $squaresum = shift;
  66   my $count = shift;
  67   return sqrt( 1 / $count * ( $squaresum - $sum*$sum / $count ))
  68 }
  69
  70 mkdir "db-$$" or die $!;
  71 chdir "db-$$";
  72
  73 my $totaldbs=10;
  74 my $createddbs=0;
  75 my %path;
  76 my $time=time;
  77 my $prevups;
  78 my $over = 0;
  79
  80 while (1) {
  81
  82     # create ###############################################################
  83     my $squaresum=0;
  84     my $sum=0;
  85     my $count=0;
  86
  87     for(my $db=$createddbs;$db<$totaldbs;$db++){
  88         # make sure we do not get bitten by
  89         # expensive directory searches
  90         # store 100 rrds per directory.
  91         my $id = sprintf ("%06d",$db);
  92         $id =~ s/^(.)(.)(.)(.)//;
  93         $path{$db}="$1/$2/$3/$4/$id";
  94         -d "$1" or mkdir "$1";
  95         -d "$1/$2" or mkdir "$1/$2";
  96         -d "$1/$2/$3" or mkdir "$1/$2/$3";
  97         -d "$1/$2/$3/$4" or mkdir "$1/$2/$3/$4";
  98
  99         $createddbs=$db+1;
 100
 101         my $total = create $path{$db};
 102         $sum += $total;
 103         $squaresum += $total*$total;
 104         $count++;
 105     }
 106     printf STDERR "Create %6d rrds %6d c/s (%6.5f sdv)",$count,$count/$sum,stddev($sum,$squaresum,$count);
 107
 108     # update #################################################################
 109
 110    $squaresum=0;
 111    $sum=0;
 112    $count=0;
 113    my $now = time;
 114    while(1){
 115        for(my $db=0;$db<$totaldbs;$db++){
 116            my $total = update($path{$db},$time);
 117            $sum += $total;
 118            $squaresum += $total*$total;
 119            $count++;
 120         }
 121         $time += 300;
 122         last if time - $now > 5; # stop testing after 5 seconds or one round
 123     }
 124     my $ups = $count/$sum;
 125     my $sdv = stddev($sum,$squaresum,$count);
 126     printf STDERR "   Update %6d rrds  %6d u/s (%6.5f sdv)\n",$totaldbs,$ups,$sdv;
 127
 128     if ((not $prevups or $prevups / $ups < 2 or $totaldbs < 500 )and $over < 1){
 129        $totaldbs *= 2;
 130     } elsif ( $over < 1 ) {
 131        # just run another round to see if we realy hit the block
 132        $over ++;
 133        $totaldbs *= 1.3;
 134     } else {
 135        print <<NOTE;
 136
 137 * Stopping test since your system seems to have hit the cache barrier.
 138
 139 * You may want to run the test repeatedly to be sure that
 140   your system has not been busy with something other than
 141   this test.
 142
 143 * If you increas the number of rrd files above the cache barrier,
 144   the perfomance penalty should be linear.
 145
 146 * Remove the test tree in db-$$
 147
 148 NOTE
 149        exit;
 150    }
 151    $prevups = $ups;
 152 }