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
10 use lib qw( @prefix@/lib/perl );
12 print <<NOTE;
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.
23 NOTE
25 use strict;
26 use Time::HiRes qw(time);
27 use RRDs;
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 }
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 }
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 }
70 mkdir "db-$$" or die $!;
71 chdir "db-$$";
73 my $totaldbs=10;
74 my $createddbs=0;
75 my %path;
76 my $time=time;
77 my $prevups;
78 my $over = 0;
80 while (1) {
82 # create ###############################################################
83 my $squaresum=0;
84 my $sum=0;
85 my $count=0;
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";
99 $createddbs=$db+1;
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);
108 # update #################################################################
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;
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;
137 * Stopping test since your system seems to have hit the cache barrier.
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.
143 * If you increas the number of rrd files above the cache barrier,
144 the perfomance penalty should be linear.
146 * Remove the test tree in db-$$
148 NOTE
149 exit;
150 }
151 $prevups = $ups;
152 }