File Coverage

blib/lib/RRD/Editor.pm
Criterion Covered Total %
statement 1126 1297 86.8
branch 280 450 62.2
condition 77 167 46.1
subroutine 88 91 96.7
pod 36 36 100.0
total 1607 2041 78.7


line stmt bran cond sub pod time code
1             ############################################################
2             #
3             # RRD::Editor - Portable, pure perl tool to create and edit RRD files.
4             #
5             ############################################################
6              
7             package RRD::Editor;
8              
9 6     6   363863 use 5.8.8; # nan doesn't seem to be supported properly by perl before this
  6         44  
10 6     6   31 use strict;
  6         9  
  6         105  
11 6     6   26 use warnings;
  6         9  
  6         194  
12              
13             require Exporter;
14 6     6   2397 use POSIX qw/strftime/;
  6         29631  
  6         24  
15 6     6   6831 use Carp qw(croak carp cluck);
  6         10  
  6         677  
16             #use Getopt::Long qw(GetOptionsFromString :config pass_through);
17 6     6   3523 use Getopt::Long qw(:config pass_through);
  6         62104  
  6         30  
18 6     6   3584 use Time::HiRes qw(time);
  6         6495  
  6         50  
19 6     6   1039 use Config;
  6         12  
  6         210  
20              
21 6     6   26 use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS @ISA);
  6         9  
  6         694  
22              
23             $VERSION = '0.21';
24              
25             @ISA = qw(Exporter);
26             @EXPORT = qw();
27             @EXPORT_OK = qw(
28             open close create update info dump fetch
29             last set_last lastupdate minstep
30             DS_names DS_heartbeat set_DS_heartbeat DS_min set_DS_min DS_max set_DS_max DS_type set_DS_type rename_DS add_DS delete_DS
31             num_RRAs RRA_numrows RRA_type RRA_step RRA_xff set_RRA_xff RRA_el set_RRA_el add_RRA delete_RRA resize_RRA
32             );
33             %EXPORT_TAGS = (all => \@EXPORT_OK);
34              
35              
36             # define sizes of long ints and floats for the various file encodings
37 6     6   51 use constant NATIVE_LONG_EL_SIZE => $Config{longsize};
  6         9  
  6         823  
38 6     6   33 use constant NATIVE_DOUBLE_EL_SIZE => $Config{doublesize};
  6         10  
  6         525  
39 6     6   32 use constant PORTABLE_LONG_EL_SIZE => 4; # 32 bits
  6         10  
  6         247  
40 6     6   26 use constant PORTABLE_SINGLE_EL_SIZE => 4; # IEEE 754 single is 32 bits
  6         10  
  6         252  
41 6     6   36 use constant PORTABLE_DOUBLE_EL_SIZE => 8; # IEEE 754 double is 64 bits
  6         7  
  6         644  
42              
43              
44             # try to figure out the endian-ness of this machine; assumes IEEE 754 doubles which should be ok on all modern machines
45             sub _endian {
46 6     6   28 my $endiantest=unpack("h*", pack("d","1000.1234"));
47 6 50       23 if ($endiantest eq "c92a329bcf04f804") {
    0          
    0          
48 6         1279 return "little";
49             } elsif ($endiantest eq "04f804cf9b322ac9") {
50 0         0 return "big"; # big endian
51             } elsif ($endiantest eq "cf04f804c92a329b") {
52 0         0 return "mixed"; # mixed endian (used by some ARM processors)
53             } else {
54 0         0 return "unknown";
55             }
56             }
57 6     6   32 use constant ENDIAN => _endian();
  6         9  
  6         11  
58            
59             # sort out the float cookie used by RRD files
60             sub _cookie {
61             # Getting RRD file float cookie right is a little tricky because Perl rounds 8.642135E130 up to 8.6421500000000028e+130 on
62             # Intel 32 bit machines, and rounds to something else on 64 bit machines, and neither of these give the same bit sequence as
63             # C when Perl stores 8.642135E130. Sigh ...
64            
65             # See if we can make a call to C to get the float cookie. Reliable, but needs Inline module to be available.
66 6     6   14 eval {
67 6         61 load Inline C => <<'END';
68             double _cookie_C() {
69             return 8.642135E130;
70             }
71             END
72 0         0 return pack("d",_cookie_C());
73             };
74             # Inline not available.
75             # Try approach that avoids need for Inline module. Ok so long as machine uses IEEE doubles (i.e. seems like all modern machines)
76             # and little-endian, big-endian and mixed-endian byte order (all modern machines that I know of, museum pieces excepted):
77 6         11 if (ENDIAN eq "little") {
78 6         551 return chr(47). chr(37). chr(192). chr(199). chr(67). chr(43). chr(31). chr(91); # little endian
79             } elsif (ENDIAN eq "big") {
80             return chr(91). chr(31). chr(43). chr(67). chr(199). chr(192). chr(37). chr(47); # big endian
81             } elsif (ENDIAN eq "mixed") {
82             return chr(67). chr(43). chr(31). chr(91). chr(47). chr(37). chr(192). chr(199); # mixed endian (used by some ARM processors)
83             } else {
84             warn("Warning: To work with native (non-portable) RRD files, you need to install the perl Inline C module (e.g. by typing 'cpan -i Inline')\n");
85             return chr(67). chr(43). chr(31). chr(91). chr(47). chr(37). chr(192). chr(199);
86             }
87             }
88 6     6   39 use constant DOUBLE_FLOATCOOKIE => 8.642135E130;
  6         16  
  6         314  
89 6     6   27 use constant NATIVE_BINARY_FLOATCOOKIE => _cookie();
  6         17  
  6         12  
90 6     6   31 use constant PORTABLE_BINARY_FLOATCOOKIE => chr(47). chr(37). chr(192). chr(199). chr(67). chr(43). chr(31). chr(91); # portable format is always little-endian
  6         10  
  6         254  
91 6     6   28 use constant SINGLE_FLOATCOOKIE => 8.6421343830016e+13; # cookie to use when storing floats in single precision as +130 exponent on old cookie is too large
  6         9  
  6         5631  
92              
93             sub _native_double {
94             # try to figure out the long/double alignment needed for the RRDTOOL file format
95 0 0 0 0   0 if ($Config{myarchname} =~ m/(sun|sparc|mips|irix|ppc|powerpc|arm)/i && NATIVE_LONG_EL_SIZE==4) {
96             # Only affects behaviour when writing new files from scratch, otherwise can figure out the right alignment to use when
97             # reading an existing file
98             # Align longs on 32 bit boundaries and doubles on 64 bit boundaries.
99 0         0 return "native-double-mixed";
100             } else {
101             # Intel/AMD processors, DEC alpha processors - should probably swap these checks around since most machines are double-mixed ?
102             # Otherwise, align longs/doubles on 32 bit machines on 32 bit boundaries, and 64 bit machines on 64 bit boundaries.
103 0         0 return "native-double-simple";
104             }
105             }
106              
107             # check whether perl pack function supports little-endian usage:
108             eval {
109             my $test=pack("d<",\(DOUBLE_FLOATCOOKIE));
110             };
111             our $PACK_LITTLE_ENDIAN_SUPPORT = (length($@)>0 ? 0 : 1);
112              
113             # Define NaN, Inf, -Inf. Not as easy as it sounds - usually "nan", "inf", "-inf" works, but not always e.g. on older versions of perl, on SH4 etc
114             sub _isNan {
115 2027   66 2027   6979 return $_[0] eq "nan" || $_[0] != $_[0]; # NaN is the only quantity that does not equal itself
116             }
117             sub _isInf {
118 1137   100 1137   2711 return $_[0] > 0 && ($_[0]*10 == $_[0]); # Inf remains equal to itself after arithmetic
119             }
120             sub _NaN {
121             # try using the IEEE 754 NaN bit pattern
122 6     6   13 my $nan;
123 6         6 if (ENDIAN eq "little") {
124 6         22 $nan= unpack("d", scalar reverse pack "H*", "7FF8000000000000");# little endian
125 6 50       20 if (_isNan($nan)) { return $nan;}
  6         308  
126             } elsif (ENDIAN eq "big") {
127             $nan= unpack("d", scalar pack "H*", "7FF8000000000000"); # big endian
128             if (_isNan($nan)) { return $nan;}
129             } elsif (ENDIAN eq "mixed") {
130             $nan= unpack("d", scalar pack "H*", "000000007FF80000"); # mixed endian (used by some ARM processors)
131             if (_isNan($nan)) { return $nan;}
132             }
133             # last ditch attempt. try perl "nan" string. Doesn't work on all OS's since its relies on the interpretation made by a native C library call
134 0         0 $nan = 0+"nan";
135 0 0       0 if (_isNan($nan)) {return $nan;}
  0         0  
136 0         0 warn("Warning: Looks like you have no NaN support. Might have problems reading rrd files.");
137 0         0 return 0;
138             }
139             sub _Inf {
140             # try using the IEEE 754 Inf bit pattern
141 6     6   25 my $inf;
142 6         8 if (ENDIAN eq "little") {
143 6         31 $inf= unpack("d", scalar reverse pack "H*", "7FF0000000000000");# little endian
144 6 50       29 if (_isInf($inf)) {return $inf;}
  6         264  
145             } elsif (ENDIAN eq "big") {
146             $inf= unpack("d", scalar pack "H*", "7FF0000000000000"); # big endian
147             if (_isInf($inf)) {return $inf;}
148             } elsif (ENDIAN eq "mixed") {
149             $inf= unpack("d", scalar pack "H*", "000000007FF00000"); # mixed endian (used by some ARM processors)
150             if (_isInf($inf)) {return $inf;}
151             }
152             # didn't work.
153 0         0 $inf = 0+"inf";
154 0 0       0 if (_isInf($inf)) {return $inf;}
  0         0  
155 0         0 warn("Warning: Looks like you have no Inf support. Might have problems reading rrd files.");
156 0         0 return 1;
157             }
158             sub _strfloat {
159             # convert a float to a string in a standard way i.e. removing cross-platform variation in strings displayed for nan and inf
160 805 100   805   867 if (_isNan($_[0])) {
    100          
    100          
161 232         540 return "nan";
162             } elsif (_isInf($_[0])) {
163 19         38 return "inf" ;
164             } elsif (_isInf(-$_[0])) {
165 19         41 return "-inf" ;
166             } else {
167 535         541 my $digits=10;
168 535 50       650 if ($_[1]) {$digits=$_[1];}
  535         484  
169 535         1421 my $str=sprintf "%0.".$digits."e",$_[0];
170 535 50       1649 if ($str =~ m/^([+|-]?\d*[.]?\d*e[+|-]?)0(\d\d)$/) {$str=$1.$2; } # for windows - convert 3 digit exponent to 2 digits
  0         0  
171 535         1580 return $str;
172             }
173             }
174             sub _strint {
175             # convert an integer to a string in a standard way i.e. removing cross-platform variation in strings displayed for nan and inf
176 40 100   40   71 if (_isNan($_[0])) {
    50          
    50          
177 38         92 return "nan";
178             } elsif (_isInf($_[0])) {
179 0         0 return "inf" ;
180             } elsif (_isInf(-$_[0])) {
181 0         0 return "-inf" ;
182             } else {
183 2         7 return sprintf "%d",$_[0];
184             }
185             }
186              
187 6     6   41 use constant NAN => _NaN();
  6         79  
  6         20  
188 6     6   28 use constant INF => _Inf();
  6         9  
  6         11  
189              
190             # define index into elements in CDP_PREP array
191 6     6   28 use constant VAL => 0;
  6         8  
  6         246  
192 6     6   34 use constant UNKN_PDP_CNT => 1;
  6         9  
  6         203  
193 6     6   26 use constant HW_INTERCEPT => 2;
  6         13  
  6         371  
194 6     6   38 use constant HW_LAST_INTERCEPT => 3;
  6         8  
  6         232  
195 6     6   28 use constant HW_SLOPE => 4;
  6         7  
  6         179  
196 6     6   23 use constant HW_LAST_SLOPE => 5;
  6         7  
  6         186  
197 6     6   25 use constant NULL_COUNT => 6;
  6         7  
  6         204  
198 6     6   22 use constant LAST_NULL_COUNT=> 7;
  6         22  
  6         237  
199 6     6   35 use constant PRIMARY_VAL => 8;
  6         14  
  6         228  
200 6     6   30 use constant SECONDARY_VAL => 9;
  6         14  
  6         71521  
201              
202             ###### private functions
203              
204             # older versions of Getopt::Long (e.g. used on Mac OS X) don't have this function, so lets add it explicitly
205             sub _GetOptionsFromString(@) {
206 17     17   26 my ($string) = shift;
207 17         1363 require Text::ParseWords;
208 17         3315 my @temp=@ARGV;
209 17         37 @ARGV = Text::ParseWords::shellwords($string);
210 17         1481 my $ret = GetOptions(@_);
211 17         4913 my @args=@ARGV;
212 17         24 @ARGV=@temp;
213 17         43 return ( $ret, \@args );
214             }
215              
216             ### used to extract information from raw RRD file and build corresponding structured arrays
217             sub _get_header_size {
218             # size of file header, in bytes
219 31     31   51 my $self = $_[0]; my $rrd=$self->{rrd};
  31         34  
220            
221             return $self->{DS_DEF_IDX} +
222             $self->{DS_EL_SIZE} * $rrd->{ds_cnt} +
223             $self->{RRA_DEF_EL_SIZE} * $rrd->{rra_cnt} +
224             $self->{LIVE_HEAD_SIZE} +
225             $self->{PDP_PREP_EL_SIZE} * $rrd->{ds_cnt} +
226             $self->{CDP_PREP_EL_SIZE} * $rrd->{ds_cnt} * $rrd->{rra_cnt} +
227             $self->{RRA_PTR_EL_SIZE} * $rrd->{rra_cnt}
228 31         220 +$self->{HEADER_PAD};
229             }
230              
231             ####
232             sub _packd {
233             # pack an array of doubles into a binary string, format determined by $self->{encoding}
234             # - will do packing manually if necessary, to guarantee portability
235             #my ($self,$list_ptr,$encoding) = @_;
236 344     344   440 my $encoding=$_[0]->{encoding};
237 344 100       471 if (defined($_[2])) {$encoding=$_[2];}
  2         3  
238              
239 344 50 33     1553 if ($encoding eq "native-double-simple" || $encoding eq "native-double-mixed") {
    100 33        
    50 66        
    100          
240             # backwards-compatible (with RRDTOOL) RRD format
241 0         0 return pack("d*", @{$_[1]});
  0         0  
242             } elsif ($encoding eq "native-single") {
243             # save some work - we can pack a portable-single using native float
244 6         8 return pack("f*", @{$_[1]});
  6         22  
245             } elsif ($PACK_LITTLE_ENDIAN_SUPPORT && $encoding eq "litteendian-single") {
246             # save some work - we can pack a portable-single using native float
247 0         0 return pack("f<*", @{$_[1]});
  0         0  
248             } elsif ($PACK_LITTLE_ENDIAN_SUPPORT && $encoding eq "littleendian-double") {
249             # shortcut - only difference from portable format is that native format is big-endian
250 136         132 return pack("d<*", @{$_[1]});
  136         375  
251             }
252 202         469 my $f; my $sign; my $shift; my $exp; my $mant; my $string=''; my $significand; my $significandlo; my $significandhi;
  202         0  
  202         0  
  202         0  
  202         187  
  202         278  
  202         0  
253 202 100 66     421 if ($encoding eq "portable-single" || $encoding eq "ieee-32") {
    50 33        
254             # manually pack an IEEE 754 32bit single precision number in little-endian order
255 75         78 for (my $i=0; $i<@{$_[1]}; $i++) {
  234         331  
256 159         144 $f=@{$_[1]}[$i];
  159         187  
257 159 100       193 if (_isNan($f)) {
    100          
    100          
    100          
258 16         17 $sign=0; $exp=255; $significand=1;
  16         14  
  16         15  
259             } elsif ($f == -1 * INF) {
260 4         5 $sign=1; $exp=255; $significand=0;
  4         5  
  4         5  
261             } elsif ($f == INF) {
262 4         5 $sign=0; $exp=255; $significand=0;
  4         4  
  4         4  
263             } elsif ($f == 0) {
264 92         92 $sign=0; $exp=0; $significand=0;
  92         79  
  92         81  
265             } else {
266 43 100       64 $sign = ($f<0) ? 1 : 0;
267 43 100       52 $f = ($f<0) ? -$f : $f;
268             # get the normalized form of f and track the exponent
269 43         43 $shift = 0;
270 43         51 while($f >= 2) { $f /= 2; $shift++; }
  284         247  
  284         321  
271 43   66     83 while($f < 1 && $f>0) { $f *= 2; $shift--; }
  71         70  
  71         123  
272 43         41 $f -= 1;
273             # calculate the binary form (non-float) of the significand data
274 43         42 $significand = int($f*(2**23));
275             # get the biased exponent
276 43         41 $exp = int($shift + ((1<<7) - 1)); # shift + bias
277             }
278 159         293 $string.=pack("V",($sign<<31) | ($exp<<23) | $significand);
279             }
280 75         130 return $string;
281             } elsif ($encoding eq "portable-double" || $encoding eq "ieee-64") {
282             # manuallly pack IEEE 754 64 bit double precision in little-endian order
283 127         135 for (my $i=0; $i<@{$_[1]}; $i++) {
  500         725  
284 373         347 $f=@{$_[1]}[$i];
  373         413  
285 373 100       415 if (_isNan($f)) {
    100          
    100          
    100          
286 136         135 $sign=0; $exp=2047; $significandhi=1;$significandlo=1;
  136         124  
  136         122  
  136         120  
287             } elsif ($f == -1 * INF) {
288 4         6 $sign=1; $exp=2047; $significandhi=0;$significandlo=0;
  4         3  
  4         4  
  4         5  
289             } elsif ($f == INF) {
290 4         5 $sign=0; $exp=2047; $significandhi=0;$significandlo=0;
  4         3  
  4         11  
  4         3  
291             } elsif ($f ==0) {
292 93         91 $sign=0; $exp=0; $significandhi=0;$significandlo=0;
  93         81  
  93         79  
  93         83  
293             } else {
294 136 100       200 $sign = ($f<0) ? 1 : 0;
295 136 100       174 $f = ($f<0) ? -$f : $f;
296             # get the normalized form of f and track the exponent
297 136         116 $shift = 0;
298 136         178 while($f >= 2) { $f /= 2; $shift++; }
  607         502  
  607         718  
299 136   66     260 while($f < 1 && $f>0 ) { $f *= 2; $shift--; }
  210         191  
  210         358  
300 136         127 $f -= 1;
301             # calculate the binary form (non-float) of the significand data
302 136         141 $significandhi = int($f*(2**20));
303 136         151 $significandlo = int( ($f-$significandhi/(2**20))*(2**52));
304             # get the biased exponent
305 136         123 $exp = int($shift + ((1<<10) - 1)); # shift + bias
306             }
307 373         730 $string.=pack("V V",$significandlo, ($sign<<31) | ($exp<<20) | $significandhi);
308             }
309 127         319 return $string;
310             } else {
311 0         0 croak("packd:unknown encoding: ".$encoding."\n");
312             }
313             }
314              
315             #####
316              
317             sub _unpackd {
318             # unpack binary string into array of doubles, format determined by $self->{encoding}
319             # - will do unpacking manually if necessary, to guarantee portability
320             #my ($self, $string, $encoding) = @_;
321 587     587   762 my $encoding=$_[0]->{encoding};
322 587 100       877 if (defined($_[2])) {$encoding=$_[2];}
  30         41  
323            
324 587 50 33     2770 if ($encoding eq "native-double-simple" || $encoding eq "native-double-mixed") {
    100 66        
    100 66        
    100          
325             # backwards-compatible (with RRDTOOL) RRD format
326 0         0 return unpack("d*", $_[1]);
327             } elsif ($encoding eq "native-single" ) {
328             # save some work - we can unpack portable-single using native float
329 19         54 return unpack("f*", $_[1]);
330             } elsif ($PACK_LITTLE_ENDIAN_SUPPORT && $encoding eq "littleendian-single" ) {
331             # save some work - we can unpack portable-single using native float
332 6         23 return unpack("f<*", $_[1]);
333             } elsif ($PACK_LITTLE_ENDIAN_SUPPORT && $encoding eq "littleendian-double") {
334             # shortcut - only difference from portable format is that native format is big-endian
335 525         1378 return unpack("d<*", $_[1]);
336             }
337 37         258 my $word; my $sign; my $expo; my $mant; my $manthi; my $mantlo; my @list; my $num; my $i;
  37         0  
  37         0  
  37         0  
  37         0  
  37         0  
  37         0  
  37         0  
338 37 100 66     116 if ($encoding eq "portable-single" || $encoding eq "ieee-32") {
    50 33        
339             # manually unpack a little-endian IEEE 754 32bit single-precision number
340 6         20 for ($i=0; $i
341 6         41 $word = (unpack("C",substr($_[1],$i+3,1)) << 24) + (unpack("C",substr($_[1],$i+2,1)) << 16) + (unpack("C",substr($_[1],$i+1,1)) << 8) + unpack("C",substr($_[1],$i,1));
342 6         13 $expo = (($word & 0x7F800000) >> 23) - 127;
343 6         53 $mant = (($word & 0x007FFFFF) | 0x00800000);
344 6 100       20 $sign = ($word & 0x80000000) ? -1 : 1;
345 6 50 33     33 if ($expo == 128 && $mant == 0 ) {
    50 33        
    50          
346 0 0       0 $num=$sign>0 ? INF : -1 * INF;
347             } elsif ($expo == 128) {
348 0         0 $num=NAN;
349             } elsif ($expo == -127 && $mant ==0) {
350 0         0 $num=0;
351             } else {
352 6         29 $num = $sign * (2**($expo-23))*$mant;
353             }
354 6         22 push (@list, $num);
355             }
356 6         19 return @list;
357             } elsif ($encoding eq "portable-double" || $encoding eq "ieee-64") {
358             # manually unpack IEEE 754 64 bit double-precision number.
359 31         62 for ($i=0; $i
360 106         256 $word = (unpack("C",substr($_[1],$i+7,1)) << 24) + (unpack("C",substr($_[1],$i+6,1)) << 16) + (unpack("C",substr($_[1],$i+5,1)) << 8) + unpack("C",substr($_[1],$i+4,1));
361 106         242 $mantlo = (unpack("C",substr($_[1],$i+3,1)) << 24) + (unpack("C",substr($_[1],$i+2,1)) << 16) + (unpack("C",substr($_[1],$i+1,1)) << 8) + unpack("C",substr($_[1],$i,1));
362 106         121 $expo = (($word & 0x7FF00000) >> 20) - 1023;
363 106         118 $manthi = ($word & 0x000FFFFF) ;
364 106 100       116 $sign = ($word & 0x80000000) ? -1 : 1;
365 106 50 66     287 if ($expo == 1024 && $mantlo == 0 && $manthi==0 ) {
    100 33        
    100 100        
      66        
366 0         0 $num=$sign * INF;
367             } elsif ($expo == 1024) {
368 16         18 $num=NAN;
369             } elsif ($expo==-1023 && $manthi==0 && $mantlo==0) {
370 1         2 $num=0;
371             } else {
372 89         207 $num = $sign * ( (2**$expo) + (2**($expo-20))*$manthi + (2**($expo-52))*$mantlo );
373             }
374 106         169 push (@list, $num);
375             }
376 31         86 return @list;
377             } else {
378 0         0 croak("unpackd:unknown encoding: ".$encoding."\n");
379             }
380             }
381              
382             #####
383             sub _packlongchar {
384             # pack encoding specification for integers. no need for manual packing/unpacking of integers as agreed portable formats already available
385 39     39   46 my $self=$_[0];
386 39 50 33     118 if ($self->{encoding} eq "native-double-simple" || $self->{encoding} eq "native-double-mixed") {
387             # backwards-compatible (with RRDTOOL) RRD format
388 0         0 return "L!"; # native long int
389             } else {
390             # portable format, little-endian 32bit long int
391 39         77 return "V";
392             }
393             }
394              
395             ####
396             sub _sizes {
397             # define the sizes of the various elements in RRD binary file
398 10     10   21 my ($self)=@_;
399            
400 10         29 $self->{OFFSET} = 12; # byte position of start of float cookie.
401 10         13 $self->{RRA_DEL_PAD} = 0; # for byte alignment in RRA_DEF after char(20) string
402 10         15 $self->{STAT_PAD} = 0; # for byte alignment at end of static header.
403 10         17 $self->{RRA_PAD} = 0; # for byte alignment at end of RRAD_DEF float array
404 10 50 33     137 if ($self->{encoding} eq "native-double-simple" || $self->{encoding} eq "native-double-mixed") {
    100 66        
    50 100        
      66        
      66        
      33        
405 0         0 $self->{LONG_EL_SIZE} = NATIVE_LONG_EL_SIZE;
406 0         0 $self->{FLOAT_EL_SIZE}= NATIVE_DOUBLE_EL_SIZE;
407 0         0 $self->{COOKIE} = NATIVE_BINARY_FLOATCOOKIE;
408 0         0 if ( NATIVE_LONG_EL_SIZE == 8) {
409             # long ints and doubles are both 64 bits, alignment is at 64 bit boundaries for both native-double-simple and native-double-mixed
410 0         0 $self->{OFFSET} = 16; # 64 bit alignment of the float cookie
411 0         0 $self->{RRA_DEL_PAD} = 4; # 64 bit alignment for first long in RRA_DEF after char(20) string
412             } elsif ( NATIVE_LONG_EL_SIZE == 4 && $self->{encoding} eq "native-double-mixed") {
413             # 32 bit native-double-mixed: align long ints at 32 bit boundaries and doubles at 64 bit boundaries.
414             $self->{OFFSET} = 16; # 64 bit alignment of the float cookie
415             $self->{RRA_DEL_PAD} = 0; # 32 bit alignment first long in RRA_DEF after char(20) string
416             $self->{STAT_PAD} = 4; # 64 bit alignment for start of DS defs
417             $self->{RRA_PAD} = 4; # 64 bit alignment for first double in RRA_DEF
418             } else {
419             # default is 32 bit native-double-simple: align both long ints and doubles at 32 bit boundaries.
420             }
421             } elsif ($self->{encoding} eq "littleendian-single" || $self->{encoding} eq "native-single" || $self->{encoding} eq "portable-single" || $self->{encoding} eq "ieee-32") {
422 2         4 $self->{LONG_EL_SIZE} = PORTABLE_LONG_EL_SIZE;
423 2         3 $self->{FLOAT_EL_SIZE}= PORTABLE_SINGLE_EL_SIZE; # 32 bits
424 2         5 my @cookie=(SINGLE_FLOATCOOKIE);
425 2         4 $self->{COOKIE} = $self->_packd(\@cookie,"portable-single");
426             } elsif ($self->{encoding} eq "littleendian-double" || $self->{encoding} eq "portable-double" || $self->{encoding} eq "ieee-64") {
427 8         13 $self->{LONG_EL_SIZE} = PORTABLE_LONG_EL_SIZE;
428 8         14 $self->{FLOAT_EL_SIZE}= PORTABLE_DOUBLE_EL_SIZE; # 64 bits
429 8         28 $self->{COOKIE} = PORTABLE_BINARY_FLOATCOOKIE;
430             }
431 10         22 $self->{DIFF_SIZE} = $self->{FLOAT_EL_SIZE} - $self->{LONG_EL_SIZE};
432 10         22 $self->{STAT_HEADER_SIZE} = $self->{OFFSET} + $self->{FLOAT_EL_SIZE} + 3 * $self->{LONG_EL_SIZE};
433 10         19 $self->{STAT_HEADER_SIZE0} = $self->{STAT_HEADER_SIZE} + 10 * $self->{FLOAT_EL_SIZE} + $self->{STAT_PAD};
434 10         14 $self->{RRA_PTR_EL_SIZE} = $self->{LONG_EL_SIZE};
435 10         19 $self->{CDP_PREP_EL_SIZE} = 10 * $self->{FLOAT_EL_SIZE};
436 10         12 $self->{PDP_PREP_PAD} = 2; # for byte alignment of char(30) string in PDP_PREP
437 10         18 $self->{PDP_PREP_EL_SIZE} = 30 + $self->{PDP_PREP_PAD} + 10 * $self->{FLOAT_EL_SIZE};
438 10         24 $self->{RRA_DEF_EL_SIZE} = 20 + $self->{RRA_DEL_PAD} + 2 * $self->{LONG_EL_SIZE} + 10 * $self->{FLOAT_EL_SIZE} +$self->{RRA_PAD};
439 10         17 $self->{DS_DEF_IDX} = $self->{STAT_HEADER_SIZE0};
440 10         16 $self->{DS_EL_SIZE} = 40 + 10 * $self->{FLOAT_EL_SIZE} ;
441 10         14 $self->{LIVE_HEAD_SIZE} = 2 * $self->{LONG_EL_SIZE};
442 10         23 $self->{HEADER_PAD} = 0; # accounting for pad bytes at end of header (e.g. 8 pad bytes are added on Linux/Intel 64 bit platforms)
443             }
444              
445             ####
446             sub _extractDSdefs {
447             # extract DS definitions from raw header (which must have been already read using rrd_open)
448 6     6   21 my ($self, $header, $idx) = @_; my $rrd=$self->{rrd};
  6         10  
449            
450 6         8 my $i;
451 6         13 my $L=$self->_packlongchar();
452 6         12 @{$rrd->{ds}}=[];
  6         33  
453 6         20 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
454 24         34 my $ds={};
455             #($ds->{name}, $ds->{type}, $ds->{hb}, $ds->{min}, $ds->{max})= unpack("Z20 Z20 $L x".DIFF_SIZE." d d",substr(${$header},$idx,DS_EL_SIZE));
456 24         32 ($ds->{name}, $ds->{type}, $ds->{hb})= unpack("Z20 Z20 $L",substr(${$header},$idx,40+$self->{LONG_EL_SIZE}));
  24         93  
457 24         34 ($ds->{min}, $ds->{max})= $self->_unpackd(substr(${$header},$idx+40+$self->{FLOAT_EL_SIZE},2*$self->{FLOAT_EL_SIZE}));
  24         59  
458 24         46 $rrd->{ds}[$i] = $ds;
459 24         53 $idx+=$self->{DS_EL_SIZE};
460             #print $ds->{name}," ",$ds->{type}," ",$ds->{hb}," ",$ds->{min}," ",$ds->{max},"\n";
461             }
462             }
463              
464             ###
465             sub _extractRRAdefs {
466             # extract RRA definitions from raw header (which must have been already read using rrd_open)
467 6     6   12 my ($self, $header, $idx) = @_; my $rrd=$self->{rrd};
  6         11  
468              
469 6         7 my $i;
470 6         11 my $L=$self->_packlongchar();
471 6         9 @{$rrd->{rra}}=[];
  6         55  
472 6         26 for ($i=0; $i<$rrd->{rra_cnt}; $i++) {
473 30         37 my $rra={};
474 30         59 ($rra->{name}, $rra->{row_cnt}, $rra->{pdp_cnt})= unpack("Z".(20+$self->{RRA_DEL_PAD})." $L $L",substr(${$header},$idx,20+$self->{RRA_DEL_PAD}+2*$self->{LONG_EL_SIZE}));
  30         104  
475 30         45 ($rra->{xff})= $self->_unpackd(substr(${$header},$idx+20+$self->{RRA_DEL_PAD} + 2*$self->{LONG_EL_SIZE}+$self->{RRA_PAD}, $self->{FLOAT_EL_SIZE}));
  30         80  
476 30         56 $rrd->{rra}[$i] = $rra;
477 30         60 $idx+=$self->{RRA_DEF_EL_SIZE};
478             #print $rra->{name}," ",$rra->{row_cnt}," ",$rra->{pdp_cnt}," ",$rra->{xff},"\n";
479             }
480             }
481              
482             ####
483             sub _extractPDPprep {
484             # extract PDP prep from raw header (which must have been already read using rrd_open)
485 6     6   13 my ($self, $header, $idx) = @_; my $rrd=$self->{rrd};
  6         8  
486              
487 6         10 my $i;
488 6         17 my $L=$self->_packlongchar();
489 6         12 @{$rrd->{pdp_prep}}=[];
  6         15  
490 6         30 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
491 24         32 my $pdp={};
492 24         47 ($pdp->{last_ds}, $pdp->{unkn_sec_cnt})= unpack("Z".(30+$self->{PDP_PREP_PAD})." $L",substr(${$header},$idx,30+$self->{PDP_PREP_PAD}+$self->{LONG_EL_SIZE})); # NB Z32 instead of Z30 due to byte alignment
  24         74  
493 24         34 ($pdp->{val})= $self->_unpackd(substr(${$header},$idx+30+$self->{PDP_PREP_PAD}+$self->{FLOAT_EL_SIZE},$self->{FLOAT_EL_SIZE}));
  24         68  
494 24         61 $rrd->{ds}[$i]->{pdp_prep} = $pdp;
495 24         49 $idx+=$self->{PDP_PREP_EL_SIZE};
496             #print $pdp->{last_ds}," ",$pdp->{unkn_sec_cnt}," ",$pdp->{val},"\n";
497             }
498             }
499              
500             ###
501             sub _extractCDPprep {
502             # extract CDP prep from raw header (which must have been already read using rrd_open)
503 6     6   12 my ($self, $header, $idx) = @_; my $rrd=$self->{rrd};
  6         11  
504            
505 6         10 my $i; my $ii;
506 6         13 my $L=$self->_packlongchar();
507 6         17 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
508             #@{$rrd->{cdp_prep}[$ii]}=[];
509 30         63 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
510             # do a bit of code optimisation to aggregate function calls and array allocation here, since run inside inner loop.
511 120 50 33     355 if ($self->{encoding} eq "native-double-simple" || $self->{encoding} eq "native-double-mixed") {
    100          
512 0         0 @{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]} = unpack("d $L x".$self->{DIFF_SIZE}." d d d d $L x".$self->{DIFF_SIZE}." $L x".$self->{DIFF_SIZE}." d d",substr(${$header},$idx,$self->{CDP_PREP_EL_SIZE}));
  0         0  
  0         0  
513 0         0 $idx+=$self->{CDP_PREP_EL_SIZE};
514             } elsif ($self->{encoding} eq "native-single") {
515 20         42 @{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]} = unpack("f $L x".$self->{DIFF_SIZE}." f f f f $L x".$self->{DIFF_SIZE}." $L x".$self->{DIFF_SIZE}." f f",substr(${$header},$idx,$self->{CDP_PREP_EL_SIZE}));
  20         27  
  20         43  
516 20         41 $idx+=$self->{CDP_PREP_EL_SIZE};
517             } else {
518 100         126 @{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}=(0,0,0,0,0,0,0,0,0,0); # pre-allocate array
  100         258  
519 100         122 (@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[0])=$self->_unpackd(substr(${$header},$idx,$self->{FLOAT_EL_SIZE})); $idx+=$self->{FLOAT_EL_SIZE};
  100         188  
  100         236  
  100         170  
520 100         150 @{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[1]=unpack("$L x".$self->{DIFF_SIZE},substr(${$header},$idx,$self->{FLOAT_EL_SIZE})); $idx+=$self->{FLOAT_EL_SIZE};
  100         181  
  100         184  
  100         129  
521 100         105 @{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[2..5]=$self->_unpackd(substr(${$header},$idx,4*$self->{FLOAT_EL_SIZE})); $idx+=4*$self->{FLOAT_EL_SIZE};
  100         225  
  100         204  
  100         180  
522 100         180 @{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[6..7]=unpack("$L x".$self->{DIFF_SIZE}." $L x".$self->{DIFF_SIZE},substr(${$header},$idx,2*$self->{FLOAT_EL_SIZE})); $idx+=2*$self->{FLOAT_EL_SIZE};
  100         166  
  100         206  
  100         144  
523 100         115 @{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[8..9]=$self->_unpackd(substr(${$header},$idx,2*$self->{FLOAT_EL_SIZE})); $idx+=2*$self->{FLOAT_EL_SIZE};
  100         238  
  100         219  
  100         273  
524             }
525             }
526             }
527             }
528              
529             ###
530             sub _extractRRAptr {
531             # array of { cur_row } pointers into current row in rra from raw header (which must have been already read using rrd_open)
532 6     6   10 my ($self, $header, $idx) = @_; my $rrd=$self->{rrd};
  6         9  
533              
534 6         12 my $L=$self->_packlongchar();
535 6         13 my @ptr=unpack("$L*",substr(${$header},$idx,$self->{RRA_PTR_EL_SIZE}*$rrd->{rra_cnt}));
  6         27  
536 6         8 my $i;
537 6         19 for ($i=0; $i<$rrd->{rra_cnt}; $i++) {
538 30         71 $rrd->{rra}[$i]->{ptr}=$ptr[$i];
539             }
540             #print @ptr;
541             }
542              
543             ###
544             sub _loadRRAdata {
545             # read in and extract the RRA data. assumes rrd_open has been called to read in file header and
546             # populate the RRD data structure
547 4     4   6 my $self = $_[0]; my $rrd=$self->{rrd};
  4         6  
548 4 50       25 if (!defined($self->{fd})) {croak("loadRRDdata: must call open() first\n");}
  0         0  
549              
550 4         3 my $data; my $ds_cnt=$self->{FLOAT_EL_SIZE} * $rrd->{ds_cnt};
  4         8  
551 4         35 seek $self->{fd},$self->_get_header_size,0; # move to start of RRA data within file
552 4         17 for (my $ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
553 20         20 my $idx=0;
554 20         56 read($self->{fd}, $data, $self->{FLOAT_EL_SIZE} * $rrd->{ds_cnt}* $rrd->{rra}[$ii]->{row_cnt} );
555 20         29 my $row_cnt=$rrd->{rra}[$ii]->{row_cnt};
556 20         29 for (my $i=0; $i<$row_cnt; $i++) {
557             # rather than unpack here, do "lazy" unpacks i.e. only when needed - much faster
558             #@{$rrd->{rra}[$ii]->{data}[$i]}=unpack("d*",substr($data,$idx,$ds_cnt}) );
559 100         146 $rrd->{rra}[$ii]->{data}[$i]=substr($data,$idx,$ds_cnt);
560 100         140 $idx+=$ds_cnt;
561             }
562             #print "rra $ii:", join(", ",@{$rrd->{rra_data}[$ii][$rrd->{rra_ptr}[$ii]+1]}),"\n";
563             }
564 4         12 $rrd->{dataloaded}=1; # record the fact that the data is now loaded in memory
565             }
566              
567             ####
568             sub _findDSidx {
569             # find the index of a DS given its name
570 23     23   49 my ($self, $name) = @_; my $rrd=$self->{rrd};
  23         33  
571 23         24 my $i;
572 23         59 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
573 39 100       98 if ($rrd->{ds}[$i]->{name} eq $name) {
574 23         43 return $i;
575             }
576             }
577 0         0 return -1; # unknown source
578             }
579              
580             ################ public functions
581             sub new {
582             # create new object
583 5     5 1 3574 my $self;
584 5         15 $self->{file_name}=undef; # name of RRD file
585 5         13 $self->{fd}=undef; # file handle
586 5         12 $self->{encoding}=undef; # binary encoding within file.
587 5         12 $self->{rrd}->{version}=undef;
588 5         13 $self->{rrd}->{rra_cnt}= undef; # number of RRAs
589 5         12 $self->{rrd}->{ds_cnt}=undef; # number of DSs
590 5         13 $self->{rrd}->{pdp_step}=undef; # min time step size
591 5         10 $self->{rrd}->{last_up} = undef; # time when last updated
592 5         12 $self->{rrd}->{ds}=undef; # array of DS definitions
593 5         12 $self->{rrd}->{rra}=undef; # array of RRA info
594 5         15 $self->{rrd}->{dataloaded}=undef; # has body of RRD file been loaded into memory ?
595 5         11 bless $self;
596 5         13 return $self;
597             }
598              
599             sub DS_names {
600             # return a list containing the names of the DS's in the RRD database.
601 2     2 1 3 my $rrd=$_[0]->{rrd};
602 2         3 my @names=(); my $i;
  2         3  
603 2         4 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
604 8         15 push(@names, $rrd->{ds}[$i]->{name});
605             }
606 2         10 return @names;
607             }
608              
609             sub num_RRAs {
610             # returns the number of RRA's in the database. RRAs are indexed from 0 .. num_RRAs-1.
611 6     6 1 765 return $_[0]->{rrd}->{rra_cnt};
612             }
613              
614             sub RRA_numrows {
615             # return number of rows in a RRA
616 8     8 1 14 my ($self, $rraidx) = @_; my $rrd=$self->{rrd};
  8         13  
617 8 50 33     43 if ($rraidx > $rrd->{rra_cnt} || $rraidx<0) {croak("RRA index out of range\n");}
  0         0  
618 8         33 return $rrd->{rra}[$rraidx]->{row_cnt};
619             }
620              
621             sub RRA_type {
622             # return the type of an RRA (AVERAGE, MAX etc)
623 0     0 1 0 my ($self, $rraidx) = @_; my $rrd=$self->{rrd};
  0         0  
624 0 0 0     0 if ($rraidx > $rrd->{rra_cnt} || $rraidx<0) {croak("RRA index out of range\n");}
  0         0  
625 0         0 return $rrd->{rra}[$rraidx]->{name};
626             }
627              
628             sub RRA_step {
629             # return the step size (in seconds) used in an RRA
630 2     2 1 4 my ($self, $rraidx) = @_; my $rrd=$self->{rrd};
  2         1  
631 2 50 33     9 if ($rraidx > $rrd->{rra_cnt} || $rraidx<0) {croak("RRA index out of range\n");}
  0         0  
632 2         8 return $rrd->{rra}[$rraidx]->{pdp_cnt}*$rrd->{pdp_step};
633             }
634              
635             sub RRA_xff {
636             # return the xff value for an RRA
637 2     2 1 3 my ($self, $idx) = @_; my $rrd=$self->{rrd};
  2         3  
638 2 50 33     8 if ($idx > $rrd->{rra_cnt} || $idx<0) {croak("RRA index out of range\n");}
  0         0  
639 2         11 return $rrd->{rra}[$idx]->{xff};
640             }
641              
642             sub RRA_el {
643             # fetch a specified element from a specified RRA.
644             # given the index number of the RRA, the index of the DS and the row within the RRA (oldest row is 0),
645             # returns a pair (t,d) where t is the unix timestamp of the data point and d is the data value
646 3     3 1 9 my ($self, $rraidx, $ds_name, $tidx) = @_; my $rrd=$self->{rrd};
  3         5  
647            
648 3 50 33     12 if ($rraidx > $rrd->{rra_cnt} || $rraidx<0) {croak("RRA index out of range\n");}
  0         0  
649 3         6 my $dsidx=$self->_findDSidx($ds_name);
650 3 50 33     10 if ($tidx >= $rrd->{rra}[$rraidx]->{row_cnt} || $tidx<0) {croak("Row index out of range\n");}
  0         0  
651              
652             # load RRA data, if not already loaded
653 3 50       6 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  0         0  
654              
655 3         9 my $t = $rrd->{last_up} - $rrd->{last_up}%($rrd->{rra}[$rraidx]->{pdp_cnt}*$rrd->{pdp_step}) -($rrd->{rra}[$rraidx]->{row_cnt}-1-$tidx)*$rrd->{rra}[$rraidx]->{pdp_cnt}*$rrd->{pdp_step};
656 3         6 my $jj= ($rrd->{rra}[$rraidx]->{ptr}+1+ $tidx)%$rrd->{rra}[$rraidx]->{row_cnt};
657 3         7 my @line=$self->_unpackd($rrd->{rra}[$rraidx]->{data}[$jj]);
658 3         20 return ($t, $line[$dsidx]);
659             }
660              
661             sub set_RRA_el {
662             # change value of a specified element from a specified RRA
663             # given the index number of the RRA, the index of the DS and the row within the RRA (oldest row is 0),
664             # updates the data value to be $val
665 1     1 1 4 my ($self, $rraidx, $ds_name, $tidx, $val) = @_; my $rrd=$self->{rrd};
  1         2  
666 1         2 my $dsidx=$self->_findDSidx($ds_name);
667            
668             # load RRA data, if not already loaded
669 1 50       3 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  1         3  
670              
671 1         3 my $jj= ($rrd->{rra}[$rraidx]->{ptr}+1 + $tidx)%$rrd->{rra}[$rraidx]->{row_cnt};
672 1         3 my @line=$self->_unpackd($rrd->{rra}[$rraidx]->{data}[$jj]);
673 1         3 $line[$dsidx] = $val;
674 1         3 $rrd->{rra}[$rraidx]->{data}[$jj]=$self->_packd(\@line);
675             }
676              
677             sub last {
678             # return time of last update
679 3     3 1 11 return $_[0]->{rrd}->{last_up};
680             }
681              
682             sub set_last {
683             # change time of last update; use with caution !
684 0     0 1 0 $_[0]->{rrd}->{last_up} = $_[1];
685 0         0 return 1;
686             }
687              
688             sub lastupdate {
689             # return the most recent update values
690 3     3 1 5 my $self=$_[0]; my $rrd=$self->{rrd};
  3         4  
691              
692 3         5 my @vals;
693 3         8 for (my $i=0; $i<$rrd->{ds_cnt}; $i++) {
694 12         25 push(@vals,$rrd->{ds}[$i]->{pdp_prep}->{last_ds});
695             }
696 3         14 return @vals;
697             }
698              
699             sub minstep {
700             # return the min step size, in seconds
701 2     2 1 3 my $self=$_[0]; my $rrd=$self->{rrd};
  2         3  
702 2         7 return $rrd->{pdp_step};
703             }
704              
705             sub DS_heartbeat {
706             # return heartbeat for DS
707 2     2 1 4 my ($self, $name) = @_; my $rrd=$self->{rrd};
  2         3  
708            
709 2 50       5 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  2         4  
  0         0  
710 2         7 return $rrd->{ds}[$idx]->{hb};
711             }
712              
713             sub set_DS_heartbeat {
714             # change heartbeat for DS
715 1     1 1 3 my ($self, $name, $hb) = @_; my $rrd=$self->{rrd};
  1         2  
716            
717 1 50       4 if ($hb < $rrd->{pdp_step}) {croak("Heartbeat value must be at least the minimum step size ".$rrd->{pdp_step}." secs\n");}
  0         0  
718            
719 1 50       2 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  1         2  
  0         0  
720             # update to new value
721 1         2 $rrd->{ds}[$idx]->{hb}=$hb;
722 1         3 return 1;
723             }
724              
725             sub DS_min {
726             # return min value for DS
727 1     1 1 3 my ($self, $name) = @_; my $rrd=$self->{rrd};
  1         2  
728            
729 1 50       2 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  1         3  
  0         0  
730 1         3 return $rrd->{ds}[$idx]->{min};
731             }
732              
733             sub set_DS_min {
734             # change min value for DS
735 1     1 1 4 my ($self, $name, $min) = @_; my $rrd=$self->{rrd};
  1         1  
736            
737 1 50       3 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  1         3  
  0         0  
738             # update to new value
739 1         3 $rrd->{ds}[$idx]->{min}=$min;
740 1         2 return 1;
741             }
742              
743             sub DS_max {
744             # return max value for DS
745 1     1 1 2 my ($self, $name) = @_; my $rrd=$self->{rrd};
  1         2  
746            
747 1 50       3 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  1         3  
  0         0  
748 1         2 return $rrd->{ds}[$idx]->{max};
749             }
750              
751             sub set_DS_max {
752             # change max value for DS
753 1     1 1 3 my ($self, $name, $max) = @_; my $rrd=$self->{rrd};
  1         2  
754            
755 1 50       3 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  1         3  
  0         0  
756             # update to new value
757 1         2 $rrd->{ds}[$idx]->{max}=$max;
758 1         2 return 1;
759             }
760              
761             sub DS_type {
762             # return type of DS
763 2     2 1 3 my ($self, $name) = @_; my $rrd=$self->{rrd};
  2         3  
764            
765 2 50       4 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  2         4  
  0         0  
766 2         7 return $rrd->{ds}[$idx]->{type};
767             }
768              
769             sub set_DS_type {
770             # change type of DS
771 1     1 1 3 my ($self, $name, $type) = @_; my $rrd=$self->{rrd};
  1         2  
772            
773 1 50       2 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  1         3  
  0         0  
774 1 50       14 if ($type !~ m/(GAUGE|COUNTER|DERIVE|ABSOLUTE)/) { croak("Invalid DS type\n");}
  0         0  
775             # update to new value
776 1         3 $rrd->{ds}[$idx]->{type}=$type;
777 1         4 return 1;
778             }
779              
780             sub rename_DS {
781 1     1 1 3 my ($self, $old, $new) = @_; my $rrd=$self->{rrd};
  1         2  
782              
783 1 50       3 my $idx=$self->_findDSidx($old); if ($idx<0) {croak("Unknown source\n");}
  1         2  
  0         0  
784 1         2 $rrd->{ds}[$idx]->{name}=$new;
785 1         4 return 1;
786             }
787              
788             sub add_DS {
789             # add a new DS. argument is is same format as used by create
790 1     1 1 3 my ($self, $arg) = @_; my $rrd=$self->{rrd};
  1         2  
791            
792 1 50       7 if ($arg !~ m/^DS:([a-zA-Z0-9_\-]+):(GAUGE|COUNTER|DERIVE|ABSOLUTE):([0-9]+):(U|[-\+]?[0-9\.]+):(U|[-\+]?[0-9\.]+)$/) { croak("Invalid DS spec\n");}
  0         0  
793              
794             # load RRA data, if not already loaded
795 1 50       3 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  1         2  
796              
797             # update DS definitions
798 1         2 my $ds;
799 1 50       6 my $min=$4; if ($min eq "U") {$min=NAN;} # set to NaN
  1         3  
  1         2  
800 1 50       7 my $max=$5; if ($max eq "U") {$max=NAN;} # set to NaN
  1         2  
  1         2  
801             ($ds->{name}, $ds->{type}, $ds->{hb}, $ds->{min}, $ds->{max},
802             $ds->{pdp_prep}->{last_ds}, $ds->{pdp_prep}->{unkn_sec_cnt}, $ds->{pdp_prep}->{val},
803 1         8 )= ($1,$2,$3,$min,$max,"U", $rrd->{last_up}%$rrd->{pdp_step}, 0.0);
804 1         15 $rrd->{ds}[@{$rrd->{ds}}]=$ds;
  1         2  
805 1         2 $rrd->{ds_cnt}++;
806            
807             # update RRAs
808 1         2 my $ii;
809 1         3 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
810 5         10 @{$rrd->{rra}[$ii]->{cdp_prep}[$rrd->{ds_cnt}-1]} = (NAN,(($rrd->{last_up}-$rrd->{last_up}%$rrd->{pdp_step})%($rrd->{pdp_step}*$rrd->{rra}[$ii]->{pdp_cnt}))/$rrd->{pdp_step},0,0,0,0,0,0,0,0);
  5         15  
811             }
812             # update data
813 1         2 my @line; my $i;
814 1         3 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
815 5         10 for ($i=0; $i<$rrd->{rra}[$ii]->{row_cnt}; $i++) {
816 25         38 @line=$self->_unpackd($rrd->{rra}[$ii]->{data}[$i]);
817 25         37 $line[$rrd->{ds_cnt}-1]=NAN;
818 25         34 $rrd->{rra}[$ii]->{data}[$i]=$self->_packd(\@line);
819             }
820             }
821 1         4 return 1;
822             }
823              
824             sub delete_DS {
825             # delete a DS
826 1     1 1 34 my ($self, $name) = @_; my $rrd=$self->{rrd};
  1         3  
827 1 50       3 my $idx=$self->_findDSidx($name); if ($idx<0) {croak("Unknown source\n");}
  1         4  
  0         0  
828              
829             # load RRA data, if not already loaded
830 1 50       2 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  0         0  
831              
832             # update DS definitions
833 1         2 my $i;
834 1         1 $rrd->{ds_cnt}--;
835 1         3 for ($i=$idx; $i<$rrd->{ds_cnt}; $i++) {
836 2         6 $rrd->{ds}[$i]=$rrd->{ds}[$i+1];
837             }
838            
839             # update RRAs
840 1         1 my $ii;
841 1         3 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
842 5         7 for ($i=$idx; $i<$rrd->{ds_cnt}; $i++) {
843 10         21 $rrd->{rra}[$ii]->{cdp_prep}[$i]=$rrd->{rra}[$ii]->{cdp_prep}[$i+1];
844             }
845             }
846              
847             # update data
848 1         1 my $j; my @line;
849 1         3 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
850 5         11 for ($i=0; $i<$rrd->{rra}[$ii]->{row_cnt}; $i++) {
851 25         36 @line=$self->_unpackd($rrd->{rra}[$ii]->{data}[$i]);
852 25         52 for ($j=$idx; $j<$rrd->{ds_cnt}; $j++) {
853 50         70 $line[$j]=$line[$j+1];
854             }
855 25         48 $rrd->{rra}[$ii]->{data}[$i]=$self->_packd([@line[0..$rrd->{ds_cnt}-1]]);
856             }
857             }
858 1         4 return 1;
859             }
860              
861             sub add_RRA {
862             # add a new RRA
863 1     1 1 3 my ($self, $args) = @_; my $rrd=$self->{rrd};
  1         2  
864 1 50       7 if ($args !~ m/^RRA:(AVERAGE|MAX|MIN|LAST):([0-9\.]+):([0-9]+):([0-9]+)$/) {croak("Invalid RRA spec\n");}
  0         0  
865             # load RRA data, if not already loaded
866 1 50       4 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  0         0  
867             # update RRA definitions
868 1         2 my $rra;
869 1 50       4 if ($4<1) { croak("Invalid row count $4\n");}
  0         0  
870 1 50 33     6 if ($2<0.0 || $2>1.0) { croak("Invalid xff $2: must be between 0 and 1\n");}
  0         0  
871 1 50       4 if ($3<1) { croak("Invalid step $3: must be >= 1\n");}
  0         0  
872 1         30 ($rra->{name}, $rra->{xff}, $rra->{pdp_cnt}, $rra->{row_cnt}, $rra->{ptr}, $rra->{data})=($1,$2,$3,$4,int(rand($4)),undef);
873 1         2 my $idx=@{$rrd->{rra}};
  1         2  
874 1         3 $rrd->{rra}[$idx]=$rra;
875 1         2 $rrd->{rra_cnt}++;
876            
877 1         1 my $i;
878 1         5 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
879 4         9 @{$rrd->{rra}[$idx]->{cdp_prep}[$i]} = (NAN,(($rrd->{last_up}-$rrd->{last_up}%$rrd->{pdp_step})%($rrd->{pdp_step}*$rrd->{rra}[$idx]->{pdp_cnt}))/$rrd->{pdp_step},0,0,0,0,0,0,0,0);
  4         14  
880             }
881             # update data
882 1         3 my @empty=((NAN)x$rrd->{ds_cnt});
883 1         4 for ($i=0; $i<$rrd->{rra}[$idx]->{row_cnt}; $i++) {
884 10         15 $rrd->{rra}[$idx]->{data}[$i] = $self->_packd(\@empty);
885             }
886 1         5 return 1;
887             }
888              
889             sub delete_RRA {
890             # delete an RRA
891 9     9 1 178 my ($self, $idx) = @_; my $rrd=$self->{rrd};
  9         17  
892 9 100 100     34 if ($idx >= $rrd->{rra_cnt} || $idx < 0) { croak("RRA index out of range\n"); }
  3         28  
893             # load RRA data, if not already loaded
894 6 50       15 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  0         0  
895             # update RRA
896 6         7 $rrd->{rra_cnt}--;
897 6         7 splice(@{$rrd->{rra}}, $idx, 1);
  6         23  
898 6         19 return 1;
899             }
900              
901             sub resize_RRA {
902 9     9 1 231 my ($self, $idx, $size) = @_; my $rrd=$self->{rrd};
  9         14  
903              
904 9 100 100     38 if ($idx >= $rrd->{rra_cnt} || $idx < 0) { croak("RRA index out of range\n"); }
  2         17  
905 7 50       37 if ($size < 0) {$size=0;}
  0         0  
906             # load RRA data, if not already loaded
907 7 50       15 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  0         0  
908             # update data
909 7         11 my $row_cnt = $rrd->{rra}[$idx]->{row_cnt};
910 7         10 my $ptr = $rrd->{rra}[$idx]->{ptr};
911 7         19 my $empty = $self->_packd([(NAN)x$rrd->{ds_cnt}]);
912              
913 7 100       20 if ($size > $row_cnt) {
    50          
914             # Expand
915 2         3 splice( @{$rrd->{rra}[$idx]->{data}}, $ptr+1, 0, ( ($empty)x($size-$row_cnt) ) );
  2         24  
916             } elsif ($size < $row_cnt) {
917             # Shrink; removing tail
918 5         6 my $cnt_strip = $row_cnt-$size;
919 5 100       10 my $tail = ($ptr+1 + $cnt_strip > $row_cnt ? $row_cnt - $ptr-1 : $cnt_strip);
920 5 100       8 splice(@{$rrd->{rra}[$idx]->{data}}, $ptr+1, $tail) if $tail > 0;
  4         10  
921              
922             # then removing head if remainder
923 5 100       11 splice(@{$rrd->{rra}[$idx]->{data}}, 0, $cnt_strip-$tail) if $tail < $cnt_strip;
  3         7  
924             }
925              
926 7         13 $rrd->{rra}[$idx]->{row_cnt} = $size;
927 7         20 return 1;
928             }
929              
930             sub set_RRA_xff {
931             # schange xff value for an RRA
932 1     1 1 7 my ($self, $idx, $xff) = @_; my $rrd=$self->{rrd};
  1         1  
933 1 50 33     6 if ($idx >= $rrd->{rra_cnt} || $idx < 0) { croak("RRA index out of range\n"); }
  0         0  
934 1         2 $rrd->{rra}[$idx]->{xff}=$xff;
935 1         4 return 1;
936             }
937              
938             #sub set_RRA_step {
939             # TODO: change RRA step size - will require resampling
940             #}
941              
942             sub update {
943             # a re-implementation of rrdupdate. updates file in place on disk, if possible - much faster.
944            
945 10     10 1 25 my ($self, $args_str) = @_; my $rrd=$self->{rrd};
  10         13  
946            
947 10         12 my $ret; my $args; my $template='';
  10         15  
948 10         16 ($ret, $args) = _GetOptionsFromString($args_str,
949             "template|t:s" => \$template,
950             );
951              
952             # update file in place ?
953 10         17 my $inplace; my $fd;
954 10 50       21 if (defined($rrd->{dataloaded})) {
955 10         13 $inplace="memory"; # data is already loaded into memory so do update there. will need to subsequently call save() to write data to disk
956             } else {
957 0 0       0 if (defined($self->{fd})) {
958 0         0 $inplace="file"; # data is not loaded yet, so carry out update in place in file. more efficient - no need to call save() to write data to disk.
959 0 0       0 open $self->{fd}, "+<", $self->{file_name} or croak "Couldn't open file ".$self->{file_name}.": $!\n"; # reopen file in update mode ($self->open() opens in read-only mode)
960 0         0 binmode($self->{fd});
961 0         0 $fd=$self->{fd};
962             } else {
963 0         0 croak("update: must call open() or create() first\n");
964             }
965             }
966              
967             # Parse template, if provided
968 10         13 my $i; my $j;
969 10         17 my @tmp=split(/:/,$template);
970 10         12 my @idx;
971 10 100       20 if (@tmp == 0) {
972             # no template, default to complete DS list
973 8         17 @idx=(0 .. $rrd->{ds_cnt}-1);
974             } else {
975             # read DS list from template
976 2         8 for ($i=0; $i<@tmp; $i++) {
977 7 50       34 $idx[$i]=$self->_findDSidx($tmp[$i]); if($idx[$i]<0) {croak("Unknown DS name ".$tmp[$i]."\n");}
  7         18  
  0         0  
978             }
979             }
980             # Parse update strings - updates the primary data points (PDPs)
981             # and consolidated data points (CDPs), and writes changes to the RRAs.
982 10         41 my @updvals; my @bits; my $rate; my $current_time; my $interval;
  10         0  
  10         0  
  10         0  
983 10         13 for ($i=0; $i<@{$args}; $i++) {
  20         37  
984             #parse colon-separated DS string
985 10 50       26 if ($args->[$i] =~ m/(-t|--template)/) {next;} # ignore option here
  0         0  
986 10 50       20 if ($args->[$i] =~ m/\@/) {croak("\@ time format not supported - use either N or a unix timestamp\n");}
  0         0  
987 10         23 @bits=split(/:/,$args->[$i]);
988 10 50       22 if (@bits-1 < @idx) {croak("expected ".@idx." data source readings (got ".(@bits-1).") from ".$args->[$i],"\n");}
  0         0  
989             #get_time_from_reading
990 10 50       24 if ($bits[0] eq "N") {
991 0         0 $current_time=time();
992             #normalize_time
993             } else {
994 10         16 $current_time=$bits[0];
995             }
996 10 50       24 if ($current_time < $rrd->{last_up}) {croak("attempt to update using time $current_time when last update time is ". $rrd->{last_up}."\n");}
  0         0  
997 10         13 $interval=$current_time - $rrd->{last_up};
998             # initialise values to NaN
999 10         18 for ($j=0; $j<$rrd->{ds_cnt}; $j++) {
1000 40         65 $updvals[$j]="U";
1001             }
1002 10         17 for ($j=0; $j<@idx; $j++) {
1003 39         74 $updvals[$idx[$j]] = $bits[$j+1];
1004             }
1005             # process the data sources and update the pdp_prep area accordingly
1006 10         14 my @pdp_new=();
1007 10         18 for ($j=0;$j<@updvals; $j++) {
1008 40 50       72 if ($rrd->{ds}[$j]->{hb} < $interval) {
1009             # make sure we do not build diffs with old last_ds values
1010 0         0 $rrd->{ds}[$j]->{pdp_prep}->{last_ds}="U";
1011             }
1012 40 100 66     100 if ($updvals[$j] ne "U" && $rrd->{ds}[$j]->{hb} >= $interval) {
1013 39         47 $rate=NAN;
1014 39 100       83 if ( $rrd->{ds}[$j]->{type} eq "COUNTER" ) {
    100          
    100          
1015 10 50       40 if ($updvals[$j] !~ m/^\d+$/) {croak("not a simple unsigned integer ".$updvals[$j]);}
  0         0  
1016 10 100       24 if ($rrd->{ds}[$j]->{pdp_prep}->{last_ds} ne "U") {
1017             #use bignum; # need this for next line as might be large integers
1018 9         20 $pdp_new[$j] = $updvals[$j] - $rrd->{ds}[$j]->{pdp_prep}->{last_ds};
1019             # simple overflow catcher
1020 9 100       19 if ($pdp_new[$j] < 0) {$pdp_new[$j]+=4294967296; } #2^32
  3         4  
1021 9 50       13 if ($pdp_new[$j] < 0) {$pdp_new[$j]+=18446744069414584320; } #2^64-2^32
  0         0  
1022 9         38 $rate=$pdp_new[$j]/$interval;
1023             } else {
1024 1         2 $pdp_new[$j]=NAN;
1025             }
1026             } elsif ( $rrd->{ds}[$j]->{type} eq "DERIVE" ) {
1027 9 50       29 if ($updvals[$j] !~ m/^[+|-]?\d+$/) {croak("not a simple signed integer ".$updvals[$j]);}
  0         0  
1028 9 100       17 if ($rrd->{ds}[$j]->{pdp_prep}->{last_ds} ne "U") {
1029             #use bignum; # need this for next line as might be large integers
1030 8         16 $pdp_new[$j] = $updvals[$j] - $rrd->{ds}[$j]->{pdp_prep}->{last_ds};
1031 8         11 $rate=$pdp_new[$j]/$interval;
1032             } else {
1033 1         2 $pdp_new[$j]=NAN;
1034             }
1035             } elsif ( $rrd->{ds}[$j]->{type} eq "GAUGE" ) {
1036 10 50       40 if ($updvals[$j] !~ m/^(-)?[\d]+(\.[\d]+)?$/) {croak("not a number ".$updvals[$j]);}
  0         0  
1037 10         29 $pdp_new[$j] = $updvals[$j]*$interval;
1038 10         14 $rate=$pdp_new[$j]/$interval;
1039             } else { # ABSOLUTE
1040 10         15 $pdp_new[$j] = $updvals[$j];
1041 10         19 $rate=$pdp_new[$j]/$interval;
1042             }
1043 39 50 33     48 if (!_isNan($rate)
      66        
1044             && (
1045             (!_isNan($rrd->{ds}[$j]->{max}) && $rate >$rrd->{ds}[$j]->{max})
1046             || (!_isNan($rrd->{ds}[$j]->{min}) && $rate <$rrd->{ds}[$j]->{min})
1047             )) {
1048 0         0 $pdp_new[$j]=NAN;
1049             }
1050             } else {
1051 1         13 $pdp_new[$j]=NAN;
1052             }
1053 40         95 $rrd->{ds}[$j]->{pdp_prep}->{last_ds} = $updvals[$j];
1054             }
1055             # how many PDP steps have elapsed since the last update?
1056 10         21 my $proc_pdp_st = $rrd->{last_up} - $rrd->{last_up} % $rrd->{pdp_step};
1057 10         11 my $occu_pdp_age = $current_time % $rrd->{pdp_step};
1058 10         12 my $occu_pdp_st = $current_time - $occu_pdp_age;
1059 10         14 my $pre_int; my $post_int;
1060 10 50       15 if ($occu_pdp_st > $proc_pdp_st) {
1061             # OK we passed the pdp_st moment
1062 10         15 $pre_int = $occu_pdp_st - $rrd->{last_up};
1063 10         11 $post_int = $occu_pdp_age;
1064             } else {
1065 0         0 $pre_int = $interval;
1066 0         0 $post_int=0;
1067             }
1068 10         13 my $proc_pdp_cnt = int( $proc_pdp_st / $rrd->{pdp_step} );
1069 10         22 my $elapsed_pdp_st = int( ($occu_pdp_st - $proc_pdp_st)/$rrd->{pdp_step} );
1070             # have we moved past a pdp step size since last run ?
1071 10 50       24 if ($elapsed_pdp_st == 0) {
1072             # nope, simple_update
1073 0         0 for ($j=0; $j<$rrd->{ds_cnt}; $j++) {
1074 0 0       0 if (_isNan($pdp_new[$j])) {
    0          
1075 0         0 $rrd->{ds}[$j]->{pdp_prep}->{unkn_sec_cnt} += int($interval);
1076             } elsif (_isNan($rrd->{ds}[$j]->{pdp_prep}->{val}) ) {
1077 0         0 $rrd->{ds}[$j]->{pdp_prep}->{val} = $pdp_new[$j];
1078             } else {
1079 0         0 $rrd->{ds}[$j]->{pdp_prep}->{val} += $pdp_new[$j];
1080             }
1081             }
1082             } else {
1083             # yep
1084             # process_all_pdp_st
1085 10         17 my $pre_unknown; my @pdp_temp; my $diff_pdp_st;
  10         0  
1086 10         40 for ($j=0; $j<$rrd->{ds_cnt}; $j++) {
1087             # Process an update that occurs after one of the PDP moments.
1088             # Increments the PDP value, sets NAN if time greater than the heartbeats have elapsed
1089 40         41 $pre_unknown=0;
1090 40 100       47 if (_isNan($pdp_new[$j])) {
1091 3         4 $pre_unknown=$pre_int;
1092             } else {
1093             #print $rrd->{ds}[$j]->{pdp_prep}->{val}," ";
1094 37 100       65 if (_isNan($rrd->{ds}[$j]->{pdp_prep}->{val})) {
1095 2         3 $rrd->{ds}[$j]->{pdp_prep}->{val} = 0;
1096             }
1097 37         67 $rrd->{ds}[$j]->{pdp_prep}->{val} += $pdp_new[$j]/$interval * $pre_int;
1098             }
1099             #print $pdp_new[$j]," ",$interval," ",$pre_int," ",$rrd->{ds}[$j]->{pdp_prep}->{val},"\n";
1100 40 100 66     111 if ($interval > $rrd->{ds}[$j]->{hb} || $rrd->{pdp_step}/2.0 < $rrd->{ds}[$j]->{pdp_prep}->{unkn_sec_cnt}+$pre_unknown) {
1101 5         7 $pdp_temp[$j]=NAN;
1102             } else {
1103 35         79 $pdp_temp[$j]=$rrd->{ds}[$j]->{pdp_prep}->{val}/($elapsed_pdp_st*$rrd->{pdp_step}-$rrd->{ds}[$j]->{pdp_prep}->{unkn_sec_cnt}-$pre_unknown);
1104             }
1105             #print $pdp_new[$j]," ",$pdp_temp[$j]," ",$rrd->{ds}[$j]->{pdp_prep}->{val}," ", $elapsed_pdp_st-$rrd->{ds}[$j]->{pdp_prep}->{unkn_sec_cnt}-$pre_unknown,"\n";
1106 40 100       51 if (_isNan($pdp_new[$j])) {
1107 3         7 $rrd->{ds}[$j]->{pdp_prep}->{unkn_sec_cnt} = int($post_int);
1108 3         14 $rrd->{ds}[$j]->{pdp_prep}->{val}=NAN;
1109             } else {
1110 37         42 $rrd->{ds}[$j]->{pdp_prep}->{unkn_sec_cnt} = 0;
1111 37         76 $rrd->{ds}[$j]->{pdp_prep}->{val}=$pdp_new[$j]/$interval*$post_int;
1112             #print $pdp_new[$j]," ", $interval, " ", $post_int, " ",$rrd->{ds}[$j]->{pdp_prep}->{val},"\n";
1113             }
1114             }
1115             # update_all_cdp_prep. Iterate over all the RRAs for a given DS and update the CDP
1116 10         37 my $current_cf; my $start_pdp_offset; my @rra_step_cnt;
  10         0  
1117 10         0 my $cum_val; my $cur_val; my $pdp_into_cdp_cnt; my $ii;
  10         0  
  10         0  
  10         0  
1118 10         26 my $idx=$self->_get_header_size; # file position (used by in place updates)
1119 10         18 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
1120 50         69 $start_pdp_offset = $rrd->{rra}[$ii]->{pdp_cnt} - $proc_pdp_cnt % $rrd->{rra}[$ii]->{pdp_cnt};
1121 50 100       73 if ($start_pdp_offset <= $elapsed_pdp_st) {
1122 30         56 $rra_step_cnt[$ii] = int(($elapsed_pdp_st - $start_pdp_offset)/$rrd->{rra}[$ii]->{pdp_cnt}) + 1;
1123             } else {
1124 20         22 $rra_step_cnt[$ii] = 0;
1125             }
1126             # update_cdp_prep. update CDP_PREP areas, loop over data sources within each RRA
1127 50         76 for ($j=0; $j<$rrd->{ds_cnt}; $j++) {
1128 200 100       256 if ($rrd->{rra}[$ii]->{pdp_cnt} > 1) {
1129             # update_cdp. Given the new reading (pdp_temp_val), update or initialize the CDP value, primary value, secondary value, and # of unknowns.
1130 160 100       192 if ($rra_step_cnt[$ii]>0) {
1131 80 100       90 if (_isNan($pdp_temp[$j])) {
1132 16         20 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[UNKN_PDP_CNT] +=$start_pdp_offset;
1133 16         23 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[SECONDARY_VAL] = NAN;
1134             } else {
1135 64         91 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[SECONDARY_VAL] = $pdp_temp[$j];
1136             }
1137 80 100       142 if ($rrd->{rra}[$ii]->{cdp_prep}[$j]->[UNKN_PDP_CNT] > $rrd->{rra}[$ii]->{pdp_cnt}*$rrd->{rra}[$ii]->{xff}) {
1138 16         26 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = NAN;
1139             } else {
1140             #initialize_cdp_val
1141 64 100       116 if ($rrd->{rra}[$ii]->{name} eq "AVERAGE") {
    100          
    100          
1142 16 50       23 if (_isNan($rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL])) {
1143 0         0 $cum_val=0.0;
1144             } else {
1145 16         24 $cum_val = $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL];
1146             }
1147 16 50       21 if (_isNan($pdp_temp[$j])) {
1148 0         0 $cur_val=0.0;
1149             } else {
1150 16         19 $cur_val = $pdp_temp[$j];
1151             }
1152 16         34 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = ($cum_val+$cur_val*$start_pdp_offset)/($rrd->{rra}[$ii]->{pdp_cnt}-$rrd->{rra}[$ii]->{cdp_prep}[$j]->[UNKN_PDP_CNT]);
1153             } elsif ($rrd->{rra}[$ii]->{name} eq "MAX") {
1154 16 50       21 if (_isNan($rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL])) {
1155 0         0 $cum_val=-1 * INF;
1156             } else {
1157 16         51 $cum_val = $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL];
1158             }
1159 16 50       24 if (_isNan($pdp_temp[$j])) {
1160 0         0 $cur_val=-1 * INF;
1161             } else {
1162 16         20 $cur_val = $pdp_temp[$j];
1163             }
1164 16 100       21 if ($cur_val > $cum_val) {
1165 8         11 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = $cur_val;
1166             } else {
1167 8         9 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = $cum_val;
1168             }
1169             } elsif ($rrd->{rra}[$ii]->{name} eq "MIN") {
1170 16 50       19 if (_isNan($rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL])) {
1171 0         0 $cum_val=INF;
1172             } else {
1173 16         20 $cum_val = $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL];
1174             }
1175 16 50       24 if (_isNan($pdp_temp[$j])) {
1176 0         0 $cur_val=INF;
1177             } else {
1178 16         21 $cur_val = $pdp_temp[$j];
1179             }
1180 16 100       19 if ($cur_val < $cum_val) {
1181 8         10 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = $cur_val;
1182             } else {
1183 8         10 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = $cum_val;
1184             }
1185             } else {
1186 16         19 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = $pdp_temp[$j];
1187             }
1188             }
1189             #*cdp_val = initialize_carry_over
1190 80         89 $pdp_into_cdp_cnt=($elapsed_pdp_st - $start_pdp_offset) % $rrd->{rra}[$ii]->{pdp_cnt};
1191 80 50 33     125 if ($pdp_into_cdp_cnt == 0 || _isNan($pdp_temp[$j])) {
1192 80 100       134 if ($rrd->{rra}[$ii]->{name} eq "MAX") {
    100          
    100          
1193 20         23 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]=-1 * INF;
1194             } elsif ($rrd->{rra}[$ii]->{name} eq "MIN") {
1195 20         24 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]=INF;
1196             } elsif ($rrd->{rra}[$ii]->{name} eq "AVERAGE") {
1197 20         24 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]=0;
1198             } else {
1199 20         23 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]=NAN;
1200             }
1201             } else {
1202 0 0       0 if ($rrd->{rra}[$ii]->{name} eq "AVERAGE") {
1203 0         0 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]=$pdp_temp[$j]*$pdp_into_cdp_cnt;
1204             } else {
1205 0         0 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]=$pdp_temp[$j];
1206             }
1207             }
1208 80 100       90 if (_isNan($pdp_temp[$j])) {
1209 16         35 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[UNKN_PDP_CNT] = ($elapsed_pdp_st - $start_pdp_offset) % $rrd->{rra}[$ii]->{pdp_cnt};
1210             } else {
1211 64         129 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[UNKN_PDP_CNT] = 0;
1212             }
1213             } else {
1214 80 100       100 if (_isNan($pdp_temp[$j])) {
1215 4         7 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[UNKN_PDP_CNT] += $elapsed_pdp_st;
1216             } else {
1217             #*cdp_val =calculate_cdp_val
1218 76 100       119 if (_isNan($rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL])) {
1219 19 50       34 if ($rrd->{rra}[$ii]->{name} eq "AVERAGE") {
1220 0         0 $pdp_temp[$j] *= $elapsed_pdp_st;
1221             }
1222 19         36 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]=$pdp_temp[$j];
1223             } else {
1224 57 100       117 if ($rrd->{rra}[$ii]->{name} eq "AVERAGE") {
    100          
    50          
1225 19         44 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]+=$pdp_temp[$j]*$elapsed_pdp_st;
1226             } elsif ($rrd->{rra}[$ii]->{name} eq "MIN") {
1227 19 50       32 if ($pdp_temp[$j] < $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]) {
1228 19         34 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL] = $pdp_temp[$j];
1229             }
1230             } elsif ($rrd->{rra}[$ii]->{name} eq "MAX") {
1231 19 50       31 if ($pdp_temp[$j] > $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL]) {
1232 19         39 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL] = $pdp_temp[$j];
1233             }
1234             } else {
1235 0         0 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[VAL] = $pdp_temp[$j];
1236             }
1237             }
1238             }
1239             }
1240             } else {
1241             # Nothing to consolidate if there's one PDP per CDP
1242 40         55 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[PRIMARY_VAL] = $pdp_temp[$j];
1243 40 50       72 if ($elapsed_pdp_st > 1) {
1244 0         0 $rrd->{rra}[$ii]->{cdp_prep}[$j]->[SECONDARY_VAL] = $pdp_temp[$j];
1245             }
1246             # consolidated with update_aberrant_cdps
1247             }
1248             } # $j ds_cnt
1249             # write to RRA
1250 50         84 for (my $scratch_idx=PRIMARY_VAL; $rra_step_cnt[$ii] >0; $rra_step_cnt[$ii]--, $scratch_idx=SECONDARY_VAL) {
1251 30         43 $rrd->{rra}[$ii]->{ptr} = ($rrd->{rra}[$ii]->{ptr}+1) % $rrd->{rra}[$ii]->{row_cnt};
1252             #write_RRA_row
1253 30         34 my @line;
1254 30         51 for ($j=0; $j<$rrd->{ds_cnt}; $j++) {
1255 120         210 push(@line, $rrd->{rra}[$ii]->{cdp_prep}[$j]->[$scratch_idx]);
1256             }
1257 30 50       41 if ($inplace eq "memory") {
1258 30         48 $rrd->{rra}[$ii]->{data}[$rrd->{rra}[$ii]->{ptr}] = $self->_packd(\@line);
1259             } else {
1260             # update in place
1261 0         0 seek $fd,$idx+$rrd->{rra}[$ii]->{ptr}*$rrd->{ds_cnt}*$self->{FLOAT_EL_SIZE},0;
1262 0         0 print $fd $self->_packd(\@line);
1263             }
1264             # rrd_notify_row
1265             }
1266 50         111 $idx+=$rrd->{rra}[$ii]->{row_cnt}*$rrd->{ds_cnt}*$self->{FLOAT_EL_SIZE}; # step file pointer to start of next RRA
1267             } # $ii rra_cnt
1268             } # complex update
1269 10         21 $rrd->{last_up}=$current_time;
1270             } # args
1271 10 50       17 if ($inplace eq "file") {
1272             # update header
1273 0         0 seek $fd,0,0;
1274             #print $fd $self->getheader();
1275 0         0 $self->_saveheader($fd);
1276             #close($fd);
1277             }
1278 10         50 return 1;
1279             }
1280              
1281             sub fetch {
1282             # dump out measurement data
1283 1     1 1 905 my ($self, $args_str) = @_; my $rrd=$self->{rrd};
  1         2  
1284 1         2 my $out='';
1285            
1286 1         2 my $step=$rrd->{pdp_step}; my $start=time()-24*60*60; my $end=time(); my $digits=10; # number of digits printed for floats
  1         4  
  1         3  
  1         2  
1287 1         1 my $ret; my $args;
1288 1         4 ($ret, $args) = _GetOptionsFromString($args_str,
1289             "resolution|r:i" => \$step,
1290             "start|s:i" => \$start,
1291             "end|e:i" => \$end,
1292             "digits|d:i" => \$digits
1293             );
1294             # at the moment, start/end times are unix timestamps.
1295 1 50       4 if ($start < 3600 * 24 * 365 * 10) {croak("the first entry to fetch should be after 1980");}
  0         0  
1296 1 50       4 if ($end < $start) {croak("start ($start) should be less than end ($end)");}
  0         0  
1297 1 50       2 if ($step<1) {croak("step must be >= 1 second");}
  0         0  
1298 1         3 my $cf=uc($args->[0]); my $i; # so CF must be first word in argument line
  1         1  
1299 1 50       6 if ($cf !~ m/AVERAGE|MIN|MAX|LAST/) {croak("unknown CF\n");}
  0         0  
1300            
1301             # find the RRA which best matches the requirements
1302 1         3 my $cal_end; my $cal_start; my $step_diff; my $firstfull=1; my $firstpart=1;
  1         0  
  1         2  
  1         1  
1303 1         2 my $full_match=$end-$start;
1304 1         1 my $best_full_step_diff=0; my $best_full_rra; my $best_match=0;
  1         2  
  1         1  
1305 1         2 my $best_part_step_diff=0; my $best_part_rra;
  1         1  
1306             my $tmp_match;
1307 1         4 for ($i = 0; $i < $rrd->{rra_cnt}; $i++) {
1308 5 100       20 if ($rrd->{rra}[$i]->{name} eq $cf) {
1309 2         4 $cal_end=$rrd->{last_up} - $rrd->{last_up}%($rrd->{rra}[$i]->{pdp_cnt}*$rrd->{pdp_step});
1310 2         4 $cal_start=$cal_end - $rrd->{rra}[$i]->{pdp_cnt}*$rrd->{rra}[$i]->{row_cnt}*$rrd->{pdp_step};
1311 2         3 $step_diff = $step-$rrd->{pdp_step}*$rrd->{rra}[$i]->{pdp_cnt};
1312 2 100       4 if ($step_diff<0) {$step_diff=-$step_diff;} # take absolute value
  1         2  
1313 2 100       3 if ($cal_start <= $start) {
1314 1 50 33     3 if ($firstfull || $step_diff < $best_full_step_diff) {
1315 1         2 $firstfull=0; $best_full_step_diff = $step_diff; $best_full_rra=$i;
  1         1  
  1         2  
1316             }
1317             } else {
1318 1         2 $tmp_match = $full_match;
1319 1 50       3 if ($cal_start>$start) {$tmp_match-=($cal_start-$start);}
  1         1  
1320 1 50 0     4 if ($firstpart || ($best_match<$tmp_match && $step_diff < $best_part_step_diff)) {
      33        
1321 1         2 $firstpart=0; $best_match=$tmp_match; $best_part_step_diff=$step_diff; $best_part_rra=$i;
  1         1  
  1         1  
  1         2  
1322             }
1323             }
1324             }
1325             }
1326 1         2 my $chosen_rra; my @line;
1327 1 50       2 if ($firstfull == 0) {$chosen_rra=$best_full_rra;}
  1 0       1  
1328 0         0 elsif ($firstpart==0) {$chosen_rra=$best_part_rra;}
1329 0         0 else {croak("the RRD does not contain an RRA matching the chosen CF");}
1330 1         2 $step = $rrd->{rra}[$chosen_rra]->{pdp_cnt}*$rrd->{pdp_step};
1331 1         2 $start -= $start % $step;
1332 1         2 $end += ($step - $end % $step);
1333              
1334             # load RRA data, if not already loaded
1335 1 50       3 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  0         0  
1336              
1337             # output column headings
1338 1         2 $out.=sprintf "%12s"," ";
1339 1         3 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
1340 4         12 $out.=sprintf "%-17s", $rrd->{ds}[$i]->{name};
1341             }
1342 1         2 $out.=sprintf "%s", "\n";
1343 1         4 my $t = $rrd->{last_up} - $rrd->{last_up}%($rrd->{rra}[$chosen_rra]->{pdp_cnt}*$rrd->{pdp_step}) -($rrd->{rra}[$chosen_rra]->{row_cnt}-1)*$rrd->{rra}[$chosen_rra]->{pdp_cnt}*$rrd->{pdp_step};
1344 1         1 my $jj; my $j;
1345 1         3 for ($j=0; $j<$rrd->{rra}[$chosen_rra]->{row_cnt}; $j++) {
1346 5 50 33     17 if ($t > $start && $t <= $end+$step) {
1347 5         10 $out.=sprintf "%10u: ",$t;
1348 5         7 $jj= ($rrd->{rra}[$chosen_rra]->{ptr}+1 + $j)%$rrd->{rra}[$chosen_rra]->{row_cnt};
1349 5         11 @line=$self->_unpackd($rrd->{rra}[$chosen_rra]->{data}[$jj]);
1350 5         10 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
1351 20         30 $out.=sprintf "%-17s",_strfloat($line[$i],$digits);
1352             }
1353 5         6 $out.=sprintf "%s", "\n";
1354             }
1355 5         9 $t+=$step;
1356             }
1357 1         9 return $out;
1358             }
1359              
1360             sub info {
1361             # dump out header info
1362 1     1 1 2 my $self=$_[0]; my $rrd = $self->{rrd};
  1         2  
1363 1         3 my $out='';
1364            
1365 1         1 my $digits=10; my $noencoding=0;
  1         2  
1366 1 50       3 if (defined($_[1])) {
1367 1         2 my $ret; my $args;
1368 1         5 ($ret, $args) = _GetOptionsFromString($_[1],
1369             "digits|d:i" => \$digits,
1370             "noformat|n" => \$noencoding
1371             );
1372             }
1373            
1374 1         6 $out.=sprintf "%s", "rrd_version = ".$rrd->{version}."\n";
1375 1 50       5 if ($noencoding<0.5) {
1376 0         0 $out.=sprintf "%s", "encoding = ";
1377 0 0 0     0 if ($self->{encoding} eq "native-double-simple" || $self->{encoding} eq "native-double-mixed") {
    0          
1378 0         0 $out.="native-double";
1379             } elsif ($self->{encoding} =~ /double/) {
1380 0         0 $out.="portable-double";
1381             } else {
1382 0         0 $out.="portable-single";
1383             }
1384 0         0 $out.=" (".$self->{encoding}.")\n";
1385             }
1386 1         4 $out.=sprintf "%s", "step = ".$rrd->{pdp_step}."\n";
1387 1         4 $out.=sprintf "%s", "last_update = ".int($rrd->{last_up})."\n";
1388 1         3 my $i; my $str; my $ii;
  1         0  
1389 1         4 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
1390 4         7 $str="ds[".$rrd->{ds}[$i]->{name}."]";
1391 4         10 $out.=sprintf "%s", "$str.index = ".$i."\n";
1392 4         8 $out.=sprintf "%s", "$str.type = \"".$rrd->{ds}[$i]->{type}."\"\n";
1393 4         17 $out.=sprintf "%s", "$str.minimal_heartbeat = ".$rrd->{ds}[$i]->{hb}."\n";
1394 4         9 $out.=sprintf "%s.min = %s\n",$str,_strint($rrd->{ds}[$i]->{min});
1395 4         8 $out.=sprintf "%s.max = %s\n",$str,_strint($rrd->{ds}[$i]->{max});
1396 4         11 $out.=sprintf "%s", "$str.last_ds = \"".$rrd->{ds}[$i]->{pdp_prep}->{last_ds}."\"\n";
1397 4         6 $out.=sprintf "%s.value = %s\n",$str,_strfloat($rrd->{ds}[$i]->{pdp_prep}->{val}, $digits);
1398 4         16 $out.=sprintf "%s", "$str.unknown_sec = ".$rrd->{ds}[$i]->{pdp_prep}->{unkn_sec_cnt}."\n";
1399             }
1400 1         4 for ($i=0; $i<$rrd->{rra_cnt}; $i++) {
1401 5         10 $str="rra[$i]";
1402 5         9 $out.=sprintf "%s", "$str.cf = \"".$rrd->{rra}[$i]->{name}."\"\n";
1403 5         9 $out.=sprintf "%s", "$str.rows = ".$rrd->{rra}[$i]->{row_cnt}."\n";
1404 5         10 $out.=sprintf "%s", "$str.cur_row = ".$rrd->{rra}[$i]->{ptr}."\n";
1405 5         16 $out.=sprintf "%s", "$str.pdp_per_row = ".$rrd->{rra}[$i]->{pdp_cnt}."\n";
1406 5         9 $out.=sprintf "%s.xff = %s\n",$str,_strfloat($rrd->{rra}[$i]->{xff},$digits);
1407 5         21 for ($ii=0; $ii<$rrd->{ds_cnt}; $ii++) {
1408 20         34 $out.=sprintf "%s.cdp_prep[$ii].value = %s\n",$str,_strfloat($rrd->{rra}[$i]->{cdp_prep}[$ii]->[VAL],$digits);
1409 20         58 $out.=sprintf "%s", "$str.cdp_prep[$ii].unknown_datapoints = ".$rrd->{rra}[$i]->{cdp_prep}[$ii]->[UNKN_PDP_CNT]."\n";
1410             }
1411             }
1412 1         25 return $out;
1413             }
1414              
1415             #sub xport {
1416             # # TO DO, incl JSON format
1417             # my ($self, $args_str) = @_; my $rrd=$self->{rrd};
1418             #}
1419              
1420             sub dump {
1421             # XML dump of RRD file
1422 4     4 1 12 my ($self, $args_str) = @_; my $rrd=$self->{rrd};
  4         9  
1423              
1424 4         6 my $noheader=0; my $notimecomments=0; my $digits=10;
  4         5  
  4         6  
1425 4 50       12 if (defined($args_str)) {
1426 4         7 my $ret; my $args;
1427 4         14 ($ret, $args) = _GetOptionsFromString($args_str,
1428             "no-header|n" => \$noheader,
1429             "notimecomments|t" => \$notimecomments,
1430             "digits|d:i" => \$digits
1431             );
1432             }
1433 4 50       14 my $timecomments = $notimecomments>0 ? 0 : 1;
1434            
1435             # load RRA data, if not already loaded
1436 4 100       13 if (!defined($rrd->{dataloaded})) {$self->_loadRRAdata;}
  1         2  
1437              
1438 4         7 my $out=''; my @line;
  4         6  
1439            
1440 4 50       17 if ($noheader<1) {
1441 4         27 $out.=sprintf "%s", ''."\n";
1442 4         9 $out.=sprintf "%s", ''."\n";
1443             }
1444 4         17 $out.=sprintf "%s", "\n\n\t".$rrd->{version}."\n";
1445 4         17 $out.=sprintf "%s", "\t".$rrd->{pdp_step}." \n\t".$rrd->{last_up}."";
1446 4 50       9 if ($timecomments) {$out.=" ";}
  0         0  
1447 4         7 $out.="\n\t";
1448 4         18 my $i; my $ii; my $j; my $jj; my $t; my $val;
  4         0  
  4         0  
  4         0  
  4         0  
1449 4         13 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
1450 16         32 $out.=sprintf "%s", "\n\t\n\t\t".$rrd->{ds}[$i]->{name}."\n\t\t";
1451 16         28 $out.=sprintf "%s", "".$rrd->{ds}[$i]->{type}."\n\t\t";
1452 16         32 $out.=sprintf "%s", "".$rrd->{ds}[$i]->{hb}."\n\t\t";
1453 16         35 $out.=sprintf "%s\n\t\t%s\n\t\t",_strint($rrd->{ds}[$i]->{min}),_strint($rrd->{ds}[$i]->{max});
1454 16         38 $out.=sprintf "%s", "\n\t\t\n\t\t".$rrd->{ds}[$i]->{pdp_prep}->{last_ds}."\n\t\t";
1455 16         29 $out.=sprintf "%s\n\t\t",_strfloat($rrd->{ds}[$i]->{pdp_prep}->{val},$digits);
1456 16         41 $out.=sprintf "%s", "".$rrd->{ds}[$i]->{pdp_prep}->{unkn_sec_cnt}."\n\t";
1457 16         32 $out.=sprintf "%s", "\n";
1458             }
1459 4         8 $out.=sprintf "%s", "\n\t\n";
1460 4         11 for ($i=0; $i<$rrd->{rra_cnt}; $i++) {
1461 20         23 $out.=sprintf "%s", "\t\n\t\t";
1462 20         38 $out.=sprintf "%s", "".$rrd->{rra}[$i]->{name}."\n\t\t";
1463 20         57 $out.=sprintf "%s", "".$rrd->{rra}[$i]->{pdp_cnt}." \n\n\t\t";
1464 20         40 $out.=sprintf "\n\t\t%s\n\t\t\n\t\t",_strfloat($rrd->{rra}[$i]->{xff},$digits);
1465 20         27 $out.=sprintf "%s", "\n\t\t";
1466 20         40 for ($ii=0; $ii<$rrd->{ds_cnt}; $ii++) {
1467 80         115 $out.=sprintf "\t\n\t\t\t%s\n\t\t\t", _strfloat($rrd->{rra}[$i]->{cdp_prep}[$ii]->[PRIMARY_VAL],$digits);
1468 80         131 $out.=sprintf "%s\n\t\t\t", _strfloat($rrd->{rra}[$i]->{cdp_prep}[$ii]->[SECONDARY_VAL],$digits);
1469 80         145 $out.=sprintf "%s\n\t\t\t",_strfloat($rrd->{rra}[$i]->{cdp_prep}[$ii]->[VAL],$digits);
1470 80         185 $out.=sprintf "%s", "". $rrd->{rra}[$i]->{cdp_prep}[$ii]->[UNKN_PDP_CNT]."\n\t\t\t";
1471 80         144 $out.=sprintf "%s", "\n\t\t";
1472             }
1473 20         24 $out.=sprintf "%s", "\n\t\t";
1474 20         20 $out.=sprintf "%s", "\n\t\t";
1475 20         53 $t = $rrd->{last_up} - $rrd->{last_up}%($rrd->{rra}[$i]->{pdp_cnt}*$rrd->{pdp_step}) -($rrd->{rra}[$i]->{row_cnt}-1)*$rrd->{rra}[$i]->{pdp_cnt}*$rrd->{pdp_step};
1476 20         38 for ($j=0; $j<$rrd->{rra}[$i]->{row_cnt}; $j++) {
1477 120         168 $jj= ($rrd->{rra}[$i]->{ptr}+1 + $j)%$rrd->{rra}[$i]->{row_cnt};
1478 120 50       152 if ($timecomments) {$out.=sprintf "\t%s", " ";}
  0         0  
1479 120         114 $out.="";
1480 120         192 @line=$self->_unpackd($rrd->{rra}[$i]->{data}[$jj]);
1481 120         206 for ($ii=0; $ii<$rrd->{ds_cnt}; $ii++) {
1482 480         659 $out.=sprintf "%s",_strfloat($line[$ii],$digits);
1483             }
1484 120         138 $out.=sprintf "%s", "\n\t\t";
1485 120         259 $t+=$rrd->{rra}[$i]->{pdp_cnt}*$rrd->{pdp_step};
1486             }
1487 20         25 $out.=sprintf "%s", "\n\t";
1488 20         39 $out.=sprintf "%s", "\n";
1489             }
1490 4         7 $out.=sprintf "%s", "\n";
1491 4         61 return $out;
1492             }
1493              
1494             ####
1495             sub _saveheader {
1496             # construct binary header for RRD file
1497 3     3   5 my $self=$_[0];
1498 3         4 my $fd=$_[1];
1499              
1500 3         8 my $L=$self->_packlongchar();
1501 3         8 my $header="\0"x $self->_get_header_size; # preallocate header
1502 3         12 substr($header,0,9,"RRD\0".$self->{rrd}->{version});
1503 3         19 substr($header,$self->{OFFSET},$self->{FLOAT_EL_SIZE}+3*$self->{LONG_EL_SIZE}, $self->{COOKIE}.pack("$L $L $L",$self->{rrd}->{ds_cnt}, $self->{rrd}->{rra_cnt}, $self->{rrd}->{pdp_step}));
1504             # DS defs
1505 3         6 my $idx=$self->{STAT_HEADER_SIZE0};
1506 3         11 for (my $i=0; $i<$self->{rrd}->{ds_cnt}; $i++) {
1507             substr($header,$idx,40+$self->{FLOAT_EL_SIZE},pack("Z20 Z20 $L x".$self->{DIFF_SIZE},
1508 12         44 $self->{rrd}->{ds}[$i]->{name}, $self->{rrd}->{ds}[$i]->{type}, $self->{rrd}->{ds}[$i]->{hb}));
1509 12         27 $idx+=40+$self->{FLOAT_EL_SIZE};
1510 12         47 my @minmax=($self->{rrd}->{ds}[$i]->{min}, $self->{rrd}->{ds}[$i]->{max});
1511 12         21 substr($header,$idx,2*$self->{FLOAT_EL_SIZE},$self->_packd(\@minmax));
1512 12         27 $idx+=9*$self->{FLOAT_EL_SIZE};
1513             }
1514             # RRA defs
1515 3         6 my $i;
1516 3         9 for ($i=0; $i<$self->{rrd}->{rra_cnt}; $i++) {
1517 15         53 substr($header,$idx,20+$self->{RRA_DEL_PAD}+2*$self->{LONG_EL_SIZE},pack("Z".(20+$self->{RRA_DEL_PAD})." $L $L",$self->{rrd}->{rra}[$i]->{name}, $self->{rrd}->{rra}[$i]->{row_cnt}, $self->{rrd}->{rra}[$i]->{pdp_cnt}));
1518 15         21 $idx+=20+$self->{RRA_DEL_PAD}+2*$self->{LONG_EL_SIZE};
1519 15         23 my @xff=($self->{rrd}->{rra}[$i]->{xff});
1520 15         26 substr($header,$idx+$self->{RRA_PAD},$self->{FLOAT_EL_SIZE},$self->_packd(\@xff));
1521 15         34 $idx += $self->{FLOAT_EL_SIZE}*10+$self->{RRA_PAD};
1522             }
1523             # live header
1524 3         10 substr($header,$idx,2*$self->{LONG_EL_SIZE},pack("$L $L", $self->{rrd}->{last_up},0));
1525 3         4 $idx+= 2*$self->{LONG_EL_SIZE};
1526             # PDP_PREP
1527 3         11 for ($i=0; $i<$self->{rrd}->{ds_cnt}; $i++) {
1528             substr($header,$idx,30+$self->{PDP_PREP_PAD}+$self->{FLOAT_EL_SIZE},
1529 12         68 pack("Z".(30+$self->{PDP_PREP_PAD})." $L x".$self->{DIFF_SIZE},$self->{rrd}->{ds}[$i]->{pdp_prep}->{last_ds}, $self->{rrd}->{ds}[$i]->{pdp_prep}->{unkn_sec_cnt}));
1530 12         16 $idx+=30+$self->{PDP_PREP_PAD}+$self->{FLOAT_EL_SIZE};
1531 12         21 my @val=($self->{rrd}->{ds}[$i]->{pdp_prep}->{val});
1532 12         27 substr($header,$idx,$self->{FLOAT_EL_SIZE},$self->_packd(\@val));
1533 12         50 $idx+= $self->{FLOAT_EL_SIZE}*9;
1534             }
1535             # CDP_PREP
1536 3         4 my @val; my $ii;
1537 3         8 for (my $ii=0; $ii<$self->{rrd}->{rra_cnt}; $ii++) {
1538 15         28 for ($i=0; $i<$self->{rrd}->{ds_cnt}; $i++) {
1539             # do a bit of code optimisation here
1540 60 50 33     176 if ($self->{encoding} eq "native-double-simple" || $self->{encoding} eq "native-double-mixed") {
    50          
1541 0         0 substr($header,$idx,$self->{CDP_PREP_EL_SIZE}, pack("d $L x".$self->{DIFF_SIZE}." d d d d $L x".$self->{DIFF_SIZE}." $L x".$self->{DIFF_SIZE}." d d",@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}));
  0         0  
1542 0         0 $idx+=$self->{CDP_PREP_EL_SIZE};
1543             } elsif ($self->{encoding} eq "native-single") {
1544 0         0 substr($header,$idx,$self->{CDP_PREP_EL_SIZE}, pack("f $L x".$self->{DIFF_SIZE}." f f f f $L x".$self->{DIFF_SIZE}." $L x".$self->{DIFF_SIZE}." f f",@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}));
  0         0  
1545 0         0 $idx+=$self->{CDP_PREP_EL_SIZE};
1546             } else {
1547 60         68 substr($header,$idx,$self->{FLOAT_EL_SIZE},$self->_packd([@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[0]]));
  60         128  
1548 60         85 $idx+=$self->{FLOAT_EL_SIZE};
1549 60         93 substr($header,$idx,$self->{FLOAT_EL_SIZE},pack("$L x".$self->{DIFF_SIZE},@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[1]));
  60         115  
1550 60         67 $idx+=$self->{FLOAT_EL_SIZE};
1551 60         74 substr($header,$idx,4*$self->{FLOAT_EL_SIZE},$self->_packd([@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[2..5]]));
  60         120  
1552 60         94 $idx+=4*$self->{FLOAT_EL_SIZE};
1553 60         105 substr($header,$idx,2*$self->{FLOAT_EL_SIZE},pack("$L x".$self->{DIFF_SIZE}." $L x".$self->{DIFF_SIZE},@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[6..7]));
  60         122  
1554 60         70 $idx+=2*$self->{FLOAT_EL_SIZE};
1555 60         72 substr($header,$idx,2*$self->{FLOAT_EL_SIZE},$self->_packd([@val=@{$self->{rrd}->{rra}[$ii]->{cdp_prep}[$i]}[8..9]]));
  60         151  
1556 60         144 $idx+=2*$self->{FLOAT_EL_SIZE};
1557             }
1558             }
1559             }
1560             # RRA PTR
1561 3         21 for ($i=0; $i<$self->{rrd}->{rra_cnt}; $i++) {
1562 15         27 substr($header,$idx,$self->{LONG_EL_SIZE},pack("$L",$self->{rrd}->{rra}[$i]->{ptr}));
1563 15         23 $idx+=$self->{LONG_EL_SIZE};
1564             }
1565             #return $header;
1566 3         24 print $fd $header;
1567             }
1568              
1569             sub save {
1570             # save RRD data to a file
1571 3     3 1 1187 my $self=$_[0];
1572            
1573             # load RRA data, if not already loaded
1574 3 100       10 if (!defined($self->{rrd}->{dataloaded})) {$self->_loadRRAdata;}
  1         3  
1575            
1576 3 50       13 if (@_>1) {
    50          
1577             # open file
1578 0         0 $self->{file_name}=$_[1];
1579             } elsif (!defined($self->{file_name})) {
1580 0         0 croak("Must either supply a filename to use or have a file already opened e.g. via calling open()\n");
1581             }
1582 3 50 33 2   64 open $self->{fd}, "+<", $self->{file_name} or open $self->{fd}, ">", $self->{file_name} or croak "Couldn't open file ".$self->{file_name}.": $!\n";
  2         11  
  2         2  
  2         16  
1583 3         1123 binmode($self->{fd});
1584 3         6 my $fd=$self->{fd};
1585              
1586 3 50       7 if (!defined($self->{encoding})) { croak("Current encoding must be defined\n.");}
  0         0  
1587 3         6 my $current_encoding=$self->{encoding};
1588 3 50       8 if (@_>2) {
1589 0         0 my $encoding=$_[2];
1590 0 0       0 if ($encoding !~ m/^(native-double|native-double-simple|native-double-mixed|portable-double|portable-single)$/) {croak("unknown format ".$encoding."\n");}
  0         0  
1591 0 0       0 if ($encoding =~ m/^native-double$/) {$encoding=_native_double();}
  0         0  
1592 0         0 $self->{encoding}=$encoding;
1593             }
1594 3         9 $self->_sizes;
1595              
1596             # output headers
1597             #print $fd $self->getheader();
1598 3         18 $self->_saveheader($fd);
1599              
1600             # output data
1601 3         9 my @line; my $i; my $ii;
  3         0  
1602 3         17 for ($ii=0; $ii<$self->{rrd}->{rra_cnt}; $ii++) {
1603 15         26 for ($i=0; $i<$self->{rrd}->{rra}[$ii]->{row_cnt}; $i++) {
1604 75 50       98 if ($self->{encoding} ne $current_encoding) {
1605             # need to convert binary data encoding
1606 0         0 @line=$self->_unpackd($self->{rrd}->{rra}[$ii]->{data}[$i],$current_encoding);
1607 0         0 $self->{rrd}->{rra}[$ii]->{data}[$i] = $self->_packd(\@line);
1608             }
1609 75         149 print $fd $self->{rrd}->{rra}[$ii]->{data}[$i];
1610             }
1611             }
1612             # done
1613 3         8 truncate($fd, tell($fd));
1614              
1615             # and exit
1616 3         15 return 1;
1617             }
1618              
1619             ####
1620             sub close {
1621             # close an open RRD file
1622 6     6 1 1250 my ($self) = @_;
1623 6 50       23 if (defined($self->{fd})) { close($self->{fd}); }
  6         57  
1624             }
1625              
1626             ####
1627              
1628             sub create {
1629             # create a new RRD
1630 1     1 1 687 my ($self, $args_str) = @_; my $rrd=$self->{rrd};
  1         7  
1631              
1632 1         7 my $last_up=time(); my $pdp_step=300;
  1         2  
1633 1         3 my $encoding="native-double"; # default to RRDTOOL compatible encoding.
1634 1         2 my $ret; my $args;
1635 1         6 ($ret, $args) = _GetOptionsFromString($args_str,
1636             "start|b:i" => \$last_up,
1637             "step|s:i" => \$pdp_step,
1638             "format|f:s" => \$encoding
1639             );
1640 1 50       3 if ($last_up < 3600 * 24 * 365 * 10) { croak("the first entry to the RRD should be after 1980\n"); }
  0         0  
1641 1 50       3 if ($pdp_step <1) {croak("step size should be no less than one second\n");}
  0         0  
1642 1 50       6 if ($encoding !~ m/^(native-double|native-double-simple|native-double-mixed|portable-double|portable-single)$/) {croak("unknown format ".$encoding."\n");}
  0         0  
1643 1 50       4 if ($encoding =~ m/^native-double$/) {$encoding=_native_double();}
  0         0  
1644 1         2 $self->{encoding}=$encoding;
1645 1         4 $self->_sizes;
1646            
1647 1         3 $rrd->{version}="0003";
1648 1         3 $rrd->{ds_cnt}=0; $rrd->{rra_cnt}=0; $rrd->{pdp_step}=$pdp_step;
  1         1  
  1         2  
1649 1         1 $rrd->{last_up}=$last_up;
1650            
1651             # now parse the DS and RRA info
1652 1         3 my $i;
1653 1         0 my $min; my $max;
1654 1         1 for ($i=0; $i<@{$args}; $i++) {
  10         13  
1655 9 100       10 if (${$args}[$i] =~ m/^DS:([a-zA-Z0-9]+):(GAUGE|COUNTER|DERIVE|ABSOLUTE):([0-9]+):(U|[+|-]?[0-9\.]+):(U|[+|-]?[0-9\.]+)$/) {
  9 50       24  
1656 4         4 my $ds;
1657 4 50       7 $min=$4; if ($min eq "U") {$min=NAN;} # set to NaN
  4         5  
  4         5  
1658 4 50       5 $max=$5; if ($max eq "U") {$max=NAN;} # set to NaN
  4         8  
  4         3  
1659             ($ds->{name}, $ds->{type}, $ds->{hb}, $ds->{min}, $ds->{max},
1660             $ds->{pdp_prep}->{last_ds}, $ds->{pdp_prep}->{unkn_sec_cnt}, $ds->{pdp_prep}->{val}
1661 4         20 )= ($1,$2,$3,$min,$max,"U", $last_up%$pdp_step, 0.0);
1662 4         6 $rrd->{ds}[@{$rrd->{ds}}]=$ds;
  4         6  
1663 4         5 $rrd->{ds_cnt}++;
1664 5         18 } elsif (${$args}[$i] =~ m/^RRA:(AVERAGE|MAX|MIN|LAST):([0-9\.]+):([0-9]+):([0-9]+)$/) {
1665 5         6 my $rra;
1666 5 50       9 if ($4<1) { croak("Invalid row count $4\n");}
  0         0  
1667 5 50 33     19 if ($2<0.0 || $2>1.0) { croak("Invalid xff $2: must be between 0 and 1\n");}
  0         0  
1668 5 50       11 if ($3<1) { croak("Invalid step $3: must be >= 1\n");}
  0         0  
1669 5         57 ($rra->{name}, $rra->{xff}, $rra->{pdp_cnt}, $rra->{row_cnt}, $rra->{ptr}, $rra->{data})=($1,$2,$3,$4,int(rand($4)),undef);
1670 5         8 $rrd->{rra}[@{$rrd->{rra}}]=$rra;
  5         13  
1671 5         9 $rrd->{rra_cnt}++;
1672             }
1673             }
1674 1 50       4 if ($rrd->{ds_cnt}<1) {croak("You must define at least one Data Source\n");}
  0         0  
1675 1 50       2 if ($rrd->{rra_cnt}<1) {croak("You must define at least one Round Robin Archive\n");}
  0         0  
1676            
1677 1         2 my $ii;
1678 1         3 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
1679 5         10 for ($i=0; $i<$rrd->{ds_cnt}; $i++) {
1680 20         30 @{$rrd->{rra}[$ii]->{cdp_prep}[$i]} = (NAN,(($last_up-$last_up%$pdp_step)%($pdp_step*$rrd->{rra}[$ii]->{pdp_cnt}))/$pdp_step,0,0,0,0,0,0,0,0);
  20         64  
1681             }
1682             }
1683            
1684             # initialise the data
1685 1         1 my $j;
1686 1         4 my @empty=((NAN)x$rrd->{ds_cnt});
1687 1         9 for ($ii=0; $ii<$rrd->{rra_cnt}; $ii++) {
1688 5         12 for ($i=0; $i<$rrd->{rra}[$ii]->{row_cnt}; $i++) {
1689 25         37 $rrd->{rra}[$ii]->{data}[$i]=$self->_packd(\@empty);
1690             }
1691             }
1692 1         6 $rrd->{dataloaded}=1; # record the fact that the data is now loaded in memory
1693             }
1694              
1695             ####
1696             sub open {
1697             # open an RRD file and read the header; reading of the body of the RRD file (containing the RRA data) is left until actually needed
1698 6     6 1 3865 my $self = $_[0]; my $rrd=$self->{rrd};
  6         19  
1699 6         11 $self->{file_name}=$_[1];
1700            
1701 6 50       255 open($self->{fd}, "<", $self->{file_name}) or croak "Couldn't open file ".$self->{file_name}.": $!\n";
1702 6         23 binmode($self->{fd});
1703 6         73 my $file_len = -s $self->{file_name};
1704              
1705             # check static part of the header (with fixed size)
1706             # header format: {cookie[4], version[5], double float_cookie, ds_cnt, rra_cnt, pdp_step, par[10] (unused array) }
1707 6         105 read($self->{fd},my $staticheader,16+8*NATIVE_DOUBLE_EL_SIZE);
1708 6         36 my $file_cookie = unpack("Z4",substr($staticheader,0,4));
1709 6 50       20 if ($file_cookie ne "RRD") { croak("Wrong magic id $file_cookie\n"); }
  0         0  
1710 6         25 $rrd->{version}=unpack("Z5",substr($staticheader,4,5));
1711 6 50 33     28 if ($rrd->{version} ne "0003" && $rrd->{version} ne "0004") { croak("Unsupported RRD version ".$rrd->{version}."\n");}
  0         0  
1712              
1713             # use float cookie to try to figure out the encoding used, taking account of variable byte alignment (e.g. float cookie starts at byte 12 on 32 bits Intel/Linux machines and at byte 16 on 64 bit Intel/Linux machines)
1714             #my ($x, $y, $byte1, $byte2, $byte3, $byte4, $byte5, $byte6, $byte7, $byte8) =unpack("Z4 Z5 x![L!] C C C C C C C C",substr($staticheader,0,length($staticheader)));
1715             #print $byte1, " ", $byte2, " ",$byte3," ", $byte4," ", $byte5," ", $byte6," ", $byte7," ", $byte8,"\n";
1716 6         14 $self->{encoding}=undef;
1717 6         30 (my $x, my $y, my $t) =unpack("Z4 Z5 x![L!] d",substr($staticheader,0,length($staticheader)));
1718 6         49 my $file_floatcookie_native_double_simple = sprintf("%0.6e", $t);
1719 6         23 ($x, $y, $t) =unpack("Z4 Z5 x![d] d",substr($staticheader,0,length($staticheader)));
1720 6         25 my $file_floatcookie_native_double_mixed = sprintf("%0.6e", $t);
1721 6         25 ($t)=$self->_unpackd(substr($staticheader,12,PORTABLE_SINGLE_EL_SIZE),"native-single");
1722 6         34 my $file_floatcookie_native_single=sprintf("%0.6e",$t);
1723 6         17 ($t)=$self->_unpackd(substr($staticheader,12,PORTABLE_SINGLE_EL_SIZE),"portable-single");
1724 6         29 my $file_floatcookie_portable_single=sprintf("%0.6e",$t);
1725 6         18 ($t)=$self->_unpackd(substr($staticheader,12,PORTABLE_DOUBLE_EL_SIZE),"portable-double");
1726 6         34 my $file_floatcookie_portable_double=sprintf("%0.6e",$t);
1727 6         11 my $file_floatcookie_littleendian_single;
1728             my $file_floatcookie_littleendian_double;
1729 6 50       16 if ($PACK_LITTLE_ENDIAN_SUPPORT>0) {
1730 6         34 ($t)=$self->_unpackd(substr($staticheader,12,PORTABLE_SINGLE_EL_SIZE),"littleendian-single");
1731 6         28 $file_floatcookie_littleendian_single=sprintf("%0.6e",$t);
1732 6         15 ($t)=$self->_unpackd(substr($staticheader,12,PORTABLE_DOUBLE_EL_SIZE),"littleendian-double");
1733 6         27 $file_floatcookie_littleendian_double=sprintf("%0.6e",$t);
1734             }
1735 6         10 my $cookie=sprintf("%0.6e",DOUBLE_FLOATCOOKIE);
1736 6         12 my $singlecookie=sprintf("%0.6e",SINGLE_FLOATCOOKIE);
1737 6 50 33     40 if ($file_floatcookie_native_double_simple eq $cookie) {
    50 0        
    100          
    50          
    0          
    0          
    0          
1738 0         0 $self->{encoding} = "native-double-simple";
1739             } elsif ($file_floatcookie_native_double_mixed eq $cookie ) {
1740 0         0 $self->{encoding} = "native-double-mixed";
1741             } elsif ($file_floatcookie_native_single eq $singlecookie ) {
1742 1         2 $self->{encoding} = "native-single";
1743             } elsif ($PACK_LITTLE_ENDIAN_SUPPORT>0 && $file_floatcookie_littleendian_double eq $cookie) {
1744 5         16 $self->{encoding} = "littleendian-double";
1745             } elsif ($PACK_LITTLE_ENDIAN_SUPPORT>0 && $file_floatcookie_littleendian_single eq $singlecookie) {
1746 0         0 $self->{encoding} = "littleendian-single";
1747             } elsif ($file_floatcookie_portable_single eq $singlecookie) {
1748 0         0 $self->{encoding} = "portable-single";
1749             } elsif ($file_floatcookie_portable_double eq $cookie) {
1750 0         0 $self->{encoding} = "portable-double";
1751             } else {
1752 0         0 croak("This RRD was created on incompatible architecture\n");
1753             }
1754             #print $self->{encoding},"\n";
1755             #$self->{encoding} = "portable-double";
1756 6         26 $self->_sizes; # now that we know the encoding, calc the sizes of the various elements in the file
1757 6         14 my $L=$self->_packlongchar;
1758              
1759             # extract info on number of DS's and RRS's, plus the pdp step size
1760 6         37 ($rrd->{ds_cnt}, $rrd->{rra_cnt}, $rrd->{pdp_step}) =unpack("$L $L $L",substr($staticheader,$self->{OFFSET} +$self->{FLOAT_EL_SIZE},3*$self->{LONG_EL_SIZE}));
1761             #print $self->{encoding}," ",$offset," ",$L," ",$self->{FLOAT_EL_SIZE}," ", $self->{LONG_EL_SIZE}," ",$rrd->{ds_cnt}," ",$rrd->{rra_cnt}," ",$rrd->{pdp_step},"\n";
1762              
1763             # read in the full header now;
1764 6         83 seek $self->{fd},0,0; # go back to start of the file
1765 6         26 read($self->{fd},my $header,$self->_get_header_size);
1766             # extract header info into structured arrays
1767 6         18 my $pos=$self->{DS_DEF_IDX};
1768 6         50 $self->_extractDSdefs(\$header,$pos);
1769            
1770 6         11 $pos+=$self->{DS_EL_SIZE}*$rrd->{ds_cnt};
1771 6         19 $self->_extractRRAdefs(\$header,$pos);
1772            
1773 6         11 $pos+=$self->{RRA_DEF_EL_SIZE}*$rrd->{rra_cnt};
1774 6         18 $rrd->{last_up} = unpack("$L",substr($header,$pos,$self->{LONG_EL_SIZE}));
1775            
1776 6         9 $pos+=$self->{LIVE_HEAD_SIZE};
1777 6         19 $self->_extractPDPprep(\$header,$pos);
1778            
1779 6         10 $pos+=$self->{PDP_PREP_EL_SIZE}*$rrd->{ds_cnt};
1780 6         20 $self->_extractCDPprep(\$header,$pos);
1781            
1782 6         12 $pos+=$self->{CDP_PREP_EL_SIZE}*$rrd->{ds_cnt}*$rrd->{rra_cnt};
1783 6         16 $self->_extractRRAptr(\$header,$pos);
1784            
1785 6         9 $pos+=$self->{RRA_PTR_EL_SIZE}*$rrd->{rra_cnt};
1786            
1787             # validate file size
1788 6         7 my $i; my $row_cnt=0;
  6         21  
1789 6         22 for ($i=0; $i<$rrd->{rra_cnt}; $i++) {
1790 30         48 $row_cnt+=$rrd->{rra}[$i]->{row_cnt};
1791             }
1792 6         12 my $correct_len=$self->_get_header_size +$self->{FLOAT_EL_SIZE} * $row_cnt*$rrd->{ds_cnt};
1793 6 50 33     32 if ($file_len < $correct_len || $file_len > $correct_len+8) { # extra 8 bytes here is to allow for padding on Linux/Intel 64 bit platforms
1794 0         0 croak($self->{file_name}." size is incorrect (is $file_len bytes but should be $correct_len bytes)");
1795             }
1796 6         9 $rrd->{dataloaded}=undef; # keep note that data is not loaded yet
1797 6         24 return $self->{encoding};
1798             }
1799              
1800             1;
1801              
1802              
1803             =pod
1804            
1805             =head1 NAME
1806            
1807             RRD::Editor - Portable, standalone (no need for RRDs.pm) tool to create and edit RRD files.
1808            
1809             =head1 SYNOPSIS
1810              
1811             use strict;
1812             use RRD::Editor ();
1813            
1814             # Create a new object
1815             my $rrd = RRD::Editor->new();
1816            
1817             # Create a new RRD with 3 data sources called bytesIn, bytesOut and
1818             # faultsPerSec and one RRA which stores 1 day worth of data at 5 minute
1819             # intervals (288 data points). The argument format is the same as that used
1820             # by 'rrdtool create', see L
1821             $rrd->create("DS:bytesIn:GAUGE:600:U:U DS:bytesOut:GAUGE:600:U:U DS:faultsPerSec:COUNTER:600:U:U RRA:AVERAGE:0.5:1:288")
1822              
1823             # Save RRD to a file
1824             $rrd->save("myfile.rrd");
1825             # The file format to use can also be optionally specified:
1826             # $rrd->save("myfile.rrd","native-double"); # default; non-portable format used by RRDTOOL
1827             # $rrd->save("myfile.rrd","portable-double"); # portable, data stored in double-precision
1828             # $rrd->save("myfile.rrd","portable-single"); # portable, data stored in single-precision
1829              
1830             # Load RRD from a file. Automagically figures out the file format
1831             # (native-double, portable-double etc)
1832             $rrd->open("myfile.rrd");
1833            
1834             # Add new data to the RRD for the same 3 data sources bytesIn,
1835             # bytesOut and faultsPerSec. The argument format is the same as that used by
1836             # 'rrdtool update', see L
1837             $rrd->update("N:10039:389:0.4");
1838            
1839             # Show information about an RRD. Output generated is similar to
1840             # 'rrdtool info'.
1841             print $rrd->info();
1842            
1843             # XML dump of RRD contents. Output generated is similar to 'rrdtool dump'.
1844             print $rrd->dump();
1845            
1846             # Extract data measurements stored in RRAs of type AVERAGE
1847             # The argument format is the same as that used by 'rrdtool fetch' and
1848             # the output generated is also similar, see
1849             # L
1850             print $rrd->fetch("AVERAGE");
1851            
1852             # Get the time when the RRD was last updated (as a unix timestamp)
1853             printf "RRD last updated at %d\n", $rrd->last();
1854              
1855             # Get the measurements added when the RRD was last updated
1856             print $rrd->lastupdate();
1857            
1858             # Get the min step size (or resolution) of the RRD. This defaults to 300s unless specified
1859             otherwise when creating an RRD.
1860             print $rrd->minstep()
1861            
1862             =head2 Edit Data Sources
1863            
1864             # Add a new data-source called bytes. Argument format is the same as $rrd->create().
1865             $rrd->add_DS("DS:bytes:GAUGE:600:U:U");
1866            
1867             # Delete the data-source bytesIn
1868             $rrd->delete_DS("bytesIn");
1869            
1870             # Get a list of the data-sources names
1871             print $rrd->DS_names();
1872            
1873             # Change the name of data-source bytes to be bytes_new
1874             $rrd->rename_DS("bytes", "bytes_new")
1875            
1876             # Get the heartbeat value for data-source bytesOut (the max number of seconds that
1877             # may elapse between data measurements)
1878             printf "Heartbeat for DS bytesOut = %d\n", $rrd->DS_heartbeat("bytesOut");
1879              
1880             # Set the heartbeat value for data-source bytesOut to be 1200 secs
1881             $rrd->set_DS_heartbeat("bytesOut",1200);
1882            
1883             # Get the type (COUNTER, GAUGE etc) of data-source bytesOut
1884             printf "Type of DS bytesOut = %s\n", $rrd->DS_type("bytesOut");
1885            
1886             # Set the type of data-source bytesOut to be COUNTER
1887             $rrd->set_DS_type("bytesOut", "COUNTER");
1888            
1889             # Get the minimum value allowed for measurements from data-source bytesOut
1890             printf "Min value of DS bytesOut = %s\n", $rrd->DS_min("bytesOut");
1891              
1892             # Set the minimum value allowed for measurements from data-source bytesOut to be 0
1893             $rrd->set_DS_min("bytesOut",0);
1894            
1895             # Get the maximum value allowed for measurements from data-source bytesOut
1896             printf "Max value of DS bytesOut = %s\n", $rrd->DS_max("bytesOut");
1897            
1898             # Set the maximum value allowed for measurements from data-source bytesOut to be 100
1899             $rrd->set_DS_max("bytesOut",100);
1900            
1901             =head2 Edit RRAs
1902            
1903             # Add a new RRA which stores 1 weeks worth of data (336 data points) at 30 minute
1904             # intervals (30 mins = 6 x 5 mins)
1905             $rrd->add_RRA("RRA:AVERAGE:0.5:6:336");
1906              
1907             # RRAs are identified by an index in range 0 .. $rrd->num_RRAs(). The index
1908             # of an RRD can also be found using $rrd->info() or $rrd->dump()
1909             my $rra_idx=1;
1910            
1911             # Delete an existing RRA with index $rra_idx.
1912             $rrd->delete_RRA($rra_idx);
1913            
1914             # Get the number of rows/data points stored in the RRA with index $rra_idx
1915             $rra_idx=0;
1916             printf "number of rows of RRA %d = %d\n", $rra_idx, $rrd->RRA_numrows($rra_idx);
1917            
1918             # Change the number of rows/data points stored in the RRA with index
1919             # $rra_idx to be 600.
1920             $rra->resize_RRA($rra_idx, 600);
1921            
1922             # Get the value of bytesIn stored at the 10th row/data-point in the
1923             # RRA with index $rra_idx.
1924             printf "Value of data-source bytesIn at row 10 in RRA %d = %d", $rra_idx, $rra->RRA_el($rra_idx, "bytesIn", 10);
1925            
1926             # Set the value of bytesIn at the 10th row/data-point to be 100
1927             $rra->set_RRA_el($rra_idx, "bytesIn", 10, 100);
1928            
1929             # Get the xff value for the RRA with index $rra_idx
1930             printf "Xff value of RRA %d = %d\n", $rra_idx, $rra->RRA_xff($rra_idx);
1931              
1932             # Set the xff value to 0.75 for the RRA with index $rra_idx
1933             $rra->RRA_xff($rra_idx,0.75);
1934            
1935             # Get the type (AVERAGE, LAST etc) of the RRA with index $rra_idx
1936             print $rrd->RRA_type($rra_idx);
1937            
1938             # Get the step (in seconds) of the RRA with index $rra_idx
1939             print $rrd->RRA_step($rra_idx);
1940              
1941              
1942             =head1 DESCRIPTION
1943              
1944             RRD:Editor implements most of the functionality of RRDTOOL, apart from graphing, plus adds some new editing and portability features. It aims to be portable and self-contained (no need for RRDs.pm).
1945            
1946             RRD::Editor provides the ability to add/delete DSs and RRAs and to get/set most of the parameters in DSs and RRAs (renaming, resizing etc). It also allows the data values stored in each RRA to be inspected and changed individually. That is, it provides almost complete control over the contents of an RRD.
1947            
1948             The RRD files created by RRDTOOL use a binary format (let's call it C) that is not portable across platforms. In addition to this file format, RRD:Editor provides two new portable file formats (C and C) that allow the exchange of files. RRD::Editor can freely convert RRD files between these three formats (C,C and C).
1949            
1950             Notes:
1951              
1952             =over
1953              
1954             =item * times must all be specified as unix timestamps (i.e. -1d, -1w etc don't work, and there is no @ option in rrdupdate).
1955              
1956             =item * there is full support for COUNTER, GAUGE, DERIVE and ABSOLUTE data-source types but the COMPUTE type is only partially supported.
1957              
1958             =item * there is full support for AVERAGE, MIN, MAX, LAST RRA types but the HWPREDICT, MHWPREDICT, SEASONAL etc types are only partially supported).
1959              
1960             =back
1961            
1962             =head1 METHODS
1963            
1964             =head2 new
1965            
1966             my $rrd=new RRD:Editor->new();
1967            
1968             Creates a new RRD::Editor object
1969            
1970             =head2 create
1971            
1972             $rrd->create($args);
1973            
1974             The method will create a new RRD with the data-sources and RRAs specified by C<$args>. C<$args> is a string that contains the same sort of command line arguments that would be passed to C. The format for C<$args> is:
1975            
1976             [--start|-b start time] [--step|-s step] [--format|-f encoding] [DS:ds-name:DST:heartbeat:min:max] [RRA:CF:xff:steps:rows]
1977            
1978             where DST may be one of GAUGE, COUNTER, DERIVE, ABSOLUTE and CF may be one of AVERAGE, MIN, MAX, LAST. Possible values for encoding are C, C, C. If omitted, defaults to C (the non-portable file format used by RRDTOOL). See L for further information.
1979            
1980             =head2 open
1981            
1982             $rrd->open($file_name);
1983            
1984             Load the RRD in the file called C<$file_name>. Only the file header is loaded initially, to improve efficiency, with the body of the file subsequently loaded if needed. The file format (C, C etc) is detected automagically.
1985              
1986             =head2 save
1987            
1988             $rrd->save();
1989             $rrd->save($file_name);
1990             $rrd->save($file_name, $encoding);
1991            
1992             Save RRD to a file called $file_name with format specified by C<$encoding>. Possible values for C<$encoding> are C<"native-double">, C<"portable-double">, C<"portable-single">.
1993            
1994             If omitted, C<$encoding> defaults to the format of the file specified when calling C, or to C<"native-double"> if the RRD has just been created using C. C is the non-portable binary format used by RRDTOOL. C is portable across platforms and stores data as double-precision values. C is portable across platforms and stores data as single-precision values (reducing the RRD file size by approximately half). If interested in the gory details, C is just the C format used by Intel 32-bit platforms (i.e. little-endian byte ordering, 32 bit integers, 64 bit IEEE 754 doubles, storage aligned to 32 bit boundaries) - an arbitrary choice, but not unreasonable since Intel platforms are probably the most widespread at the moment, and it is also compatible with web tools such as javascriptRRD L.
1995            
1996             If the RRD was opened using C, then C<$file_name> is optional and if omitted C will save the RRD to the same file as it was read from.
1997              
1998             =head2 close
1999            
2000             $rrd->close();
2001            
2002             Close an RRD file accessed using C or C. Calling C flushes any cached data to disk.
2003              
2004             =head2 info
2005            
2006             my $info = $rrd->info();
2007            
2008             Returns a string containing information on the DSs and RRAs in the RRD (but not showing the data values stored in the RRAs). Also shows details of the file format (C, C etc) if the RRD was read from a file.
2009            
2010             =head2 dump
2011            
2012             my $dump = $rrd->dump();
2013             my $dump = $rrd->dump($arg);
2014            
2015             Returns a string containing the complete contents of the RRD (including data) in XML format. C<$arg> is optional. Possible values are "--no-header" or "-n", which remove the XML header from the output string.
2016            
2017             =head2 fetch
2018            
2019             my $vals = $rrd->fetch($args);
2020            
2021             Returns a string containing a table of measurement data from the RRD. C<$args> is a string that contains the same sort of command line arguments that would be passed to C. The format for C<$args> is:
2022            
2023             CF [--resolution|-r resolution] [--start|-s start] [--end|-e end]
2024            
2025             where C may be one of AVERAGE, MIN, MAX, LAST. See L for further details.
2026              
2027             =head2 update
2028            
2029             $rrd->update($args);
2030            
2031             Feeds new data values into the RRD. C<$args> is a string that contains the same sort of command line arguments that would be passed to C. The format for C<$args> is:
2032              
2033             [--template:-t ds-name[:ds-name]...] N|timestamp:value[:value...] [timestamp:value[:value...] ...]
2034            
2035             See L for further details.
2036            
2037             Since C is often called repeatedly, in-place updating of RRD files is used where possible for greater efficiency . To understand this, a little knowledge of the RRD file format is needed. RRD files consist of a small header containing details of the DSs and RRAs, and a large body containing the data values stored in the RRAs. Reading the body into memory is relatively costly since it is much larger than the header, and so is only done by RRD::Editor on an "as-needed" basis. So long as the body has not yet been read into memory when C is called, C will update the file on disk i.e. without reading in the body. In this case there is no need to call C. If the body has been loaded into memory when C is called, then the copy of the data stored in memory will be updated and the file on disk left untouched - a call to C is then needed to freshen the file stored on disk. Seems complicated, but its actually ok in practice. If all you want to do is efficiently update a file, just use the following formula:
2038            
2039             $rrd->open($file_name);
2040             $rrd->update($args);
2041             $rrd->close();
2042            
2043             and that's it. If you want to do more, then be sure to call C when you're done.
2044            
2045             =head2 last
2046            
2047             my $unixtime = $rrd->last();
2048            
2049             Returns the time when the data stored in the RRD was last updated. The time is returned as a unix timestamp. This value should not be confused with the last modified time of the RRD file.
2050              
2051             =head2 set_last
2052            
2053             $rrd->set_last($unixtime);
2054            
2055             Set the last update time to equal C<$unixtime>. WARNING: Rarely needed, use with caution !
2056              
2057             =head2 lastupdate
2058            
2059             my @vals=$rrd->lastupdate();
2060            
2061             Return a list containing the data-source values inserted at the most recent update to the RRD
2062            
2063             =head2 minstep
2064            
2065             my $minstep = $rrd->minstep();
2066            
2067             Returns the minimum step size (in seconds) used to store data values in the RRD. RRA data intervals must be integer multiples of this step size. The min step size defaults to 300s when creating an RRD (where it is referred to as the "resolution"). NB: Changing the min step size is hard as it would require resampling all of the stored data, so we leave this "to do".
2068              
2069             =head2 add_DS
2070            
2071             $rrd->add_DS($arg);
2072              
2073             Add a new data-source to the RRD. Only one data-source can be added at a time. Details of the data-source to be added are specified by the string C<$arg>. The format of C<$arg> is:
2074            
2075             [DS:ds-name:DST:heartbeat:min:max]
2076            
2077             where DST may be one of GAUGE, COUNTER, DERIVE, ABSOLUTE i.e. the same format as used for C.
2078              
2079             =head2 delete_DS
2080            
2081             $rrd->delete_DS($ds-name);
2082              
2083             Delete the data-source with name C<$ds-name> from the RRD. WARNING: This will irreversibly delete all of the data stored for the data-source.
2084            
2085             =head2 DS_names
2086            
2087             my @ds-names = $rrd->DS_names();
2088              
2089             Returns a list containing the names of the data-sources in the RRD.
2090              
2091             =head2 rename_DS
2092              
2093             $rrd->rename_DS($ds-name, $ds-newname);
2094            
2095             Change the name of data-source C<$ds-name> to be C<$ds-newname>
2096              
2097             =head2 DS_heartbeat
2098            
2099             my $hb= $rrd->DS_heartbeat($ds-name);
2100            
2101             Returns the current heartbeat (in seconds) of a data-source. The heartbeat is the max number of seconds that may elapse between data measurements before declaring that data is missing.
2102              
2103             =head2 set_DS_heartbeat
2104            
2105             $rrd->set_DS_heartbeat($ds-name,$hb);
2106              
2107             Sets the heartbeat value (in seconds) of data-source C<$ds-name> to be C<$hb>.
2108            
2109             =head2 DS_type
2110            
2111             my $type = $rrd->DS_type($ds-name);
2112            
2113             Returns the type (GAUGE, COUNTER etc) of a data-source.
2114            
2115             =head2 set_DS_type
2116              
2117             $rrd->set_DS_type($ds-name, $type);
2118            
2119             Sets the type of data-source C<$ds-name> to be C<$type>.
2120              
2121             =head2 DS_min
2122              
2123             my $min = $rrd->DS_min($ds-name);
2124            
2125             Returns the minimum allowed for measurements from data-source C<$ds-name>. Measurements below this value are set equal to C<$mi>n when stored in the RRD.
2126            
2127             =head2 set_DS_min
2128            
2129             $rrd->set_DS_min($ds-name, $min);
2130            
2131             Set the minimum value for data-source C<$ds-name> to be C<$min>.
2132            
2133             =head2 DS_max
2134            
2135             my $max = $rrd->DS_max($ds-name);
2136            
2137             Returns the maximum allowed for measurements from data-source C<$ds-name>. Measurements above this value are set equal to C<$max> when stored in the RRD.
2138            
2139             =head2 set_DS_max
2140            
2141             $rrd->set_DS_max($ds-name, $max);
2142            
2143             Set the maximum value for data-source C<$ds-name> to be C<$max>.
2144            
2145             =head2 add_RRA
2146            
2147             $rrd->add_RRA($arg);
2148              
2149             Add a new RRA to the RRD. Only one RRA can be added at a time. Details of the RRA to be added are specified by the string C<$arg>. The format of C<$arg> is:
2150            
2151             [RRA:CF:xff:steps:rows]
2152            
2153             where CF may be one of AVERAGE, MIN, MAX, LAST i.e. the same format as used for C.
2154              
2155             =head2 num_RRAs
2156            
2157             my $num_RRAs = $rrd->num_RRAs();
2158            
2159             Returns the number of RRAs stored in the RRD. Unfortunately, unlike data-sources, RRAs are not named and so are only identified by an index in the range 0 .. C. The index of a specific RRD can be found using C or C.
2160            
2161             =head2 delete_RRA
2162            
2163             $rrd->delete_RRA($rra_idx);
2164            
2165             Delete the RRA with index C<$rra_idx> (see above discussion for how to determine the index of an RRA). WARNING: This will irreversibly delete all of the data stored in the RRA.
2166              
2167             =head2 RRA_numrows
2168              
2169             my $numrows = $rrd->RRA_numrows($rra_idx);
2170            
2171             Returns the number of rows in the RRA with index C<$rra_idx>.
2172              
2173             =head2 resize_RRA
2174              
2175             $rra->resize_RRA($rra_idx, $numrows);
2176            
2177             Change the number of rows to be C<$numrows> in the RRA with index C<$rra_idx>. WARNING: If C<$numrows> is smaller than the current row size, excess data points will be discarded.
2178              
2179             =head2 RRA_el
2180              
2181             my ($t,$val) = $rra->RRA_el($rra_idx, $ds-name, $row);
2182            
2183             Returns the timestamp and the value of data-source C<$ds-name> stored at row C<$row> in the RRA with index C<$rra_idx>. C<$row> must be in the range [0 .. C]. Row 0 corresponds to the oldest data point stored and row C to the most recent data point.
2184              
2185             =head2 set_RRA_el
2186              
2187             $rra->set_RRA_el($rra_idx, $ds-name, $row, $val);
2188            
2189             Set the stored value equal to C<$val> for data-source C<$ds-nam>e stored at row C<$row> in the RRA with index C<$rra_idx>.
2190              
2191             =head2 RRA_xff
2192              
2193             my $xff = $rra->RRA_xff($rra_idx);
2194            
2195             Returns the xff value for the RRA with index C<$rra_idx>. The xff value defines the proportion of an RRA data interval that may contain UNKNOWN data (i.e. missing data) and still be treated as known. For example, an xff value 0.5 in an RRA with data interval 300 seconds (5 minutes) means that if less than 150s of valid data is available since the last measurement, UNKNOWN will be stored in the RRA for the next data point.
2196              
2197             =head2 set_RRA_xff
2198              
2199             $rra->RRA_xff($rra_idx,$xff);
2200            
2201             Sets the xff value to C<$xff> for the RRA with index C<$rra_idx>.
2202            
2203             =head2 RRA_step
2204            
2205             my $step = $rrd->RRA_step($rra_idx);
2206            
2207             Returns the data interval (in seconds) of the RRA with index C<$rra_idx>. NB: Changing the step size is hard as it would require resampling the data stored in the RRA, so we leave this "to do".
2208            
2209             =head2 RRA_type
2210            
2211             my $type = $rrd->RRA_type($rra_idx);
2212            
2213             Returns the type of the RRA with index C<$rra_idx> i.e. AVERAGE, MAX, MIN, LAST etc. NB: Changing the type of an RRA is hard (impossible ?) as the stored data doesn't contain enough information to allow its type to be changed. To change type, its recommended instead to delete the RRA and add a new RRA with the desired type.
2214              
2215             =head1 EXPORTS
2216            
2217             You can export the following functions if you do not want to use the object orientated interface:
2218            
2219             create
2220             open
2221             save
2222             close
2223             update
2224             info
2225             dump
2226             fetch
2227             last
2228             set_last
2229             lastupdate
2230             minstep
2231             add_RRA
2232             delete_RRA
2233             num_RRAs
2234             RRA_numrows
2235             resize_RRA
2236             RRA_type
2237             RRA_step
2238             RRA_xff
2239             set_RRA_xff
2240             add_DS
2241             delete_DS
2242             DS_names
2243             rename_DS
2244             DS_heartbeat
2245             set_DS_heartbeat
2246             DS_min
2247             set_DS_min
2248             DS_max
2249             set_DS_max
2250             DS_type
2251             set_DS_type
2252              
2253             The tag C is available to easily export everything:
2254            
2255             use RRD::Editor qw(:all);
2256            
2257             =head1 Portability/Compatibility with RRDTOOL
2258            
2259             The RRD::Editor code is portable, and so long as you stick to using the C and C file formats the RRD files generated will also be portable. Portability issues arise when the C file format of RRD::Editor is used to store RRDs. This format tries to be compatible with the non-portable binary format used by RRDTOOL, which requires RRD::Editor to figure out nasty low-level details of the platform it is running on (byte ordering, byte alignment, representation used for doubles etc). To date, RRD::Editor and RRDTOOL have been confirmed compatible (i.e. they can read each others RRD files in C format) on the following architectures:
2260              
2261             Intel 386 32bit, Intel 686 32bit, AMD64/Intel x86 64bit, Itanium 64bit, Alpha 64bit, MIPS 32bit, MIPSel 32 bit, MIPS 64bit, PowerPC 32bit, ARMv6 (e.g. Raspberry Pi), SPARC 32bit, SPARC 64bit, SH4
2262            
2263             Known issues:
2264            
2265             On ARMv5 platforms RRD::Editor and RRDTOOL file formats may be only partially compatible (RRD::Editor can read RRDTOOL files, but sometimes not vice-versa depending on ARM config)
2266            
2267             For more information on RRD::Editor portability testing, see L. If your platform is not listed, there is a good chance things will "just work" but double checking that RRDTOOL can read the C format RRD files generated by RRD::Editor, and vice-versa, would be a good idea if that's important to you.
2268            
2269             =head1 SEE ALSO
2270              
2271             L command line interface for RRD::Editor, L, L, L
2272            
2273             =head1 VERSION
2274            
2275             Ver 0.21
2276            
2277             =head1 AUTHOR
2278            
2279             Doug Leith
2280              
2281             MaxiM Basunov
2282              
2283             =head1 BUGS
2284            
2285             Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
2286            
2287             =head1 COPYRIGHT
2288            
2289             Copyright 2014 D.J.Leith.
2290            
2291             This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License.
2292            
2293             See http://dev.perl.org/licenses/ for more information.
2294            
2295             =cut
2296              
2297              
2298             __END__