1# -*- perl -*- 2 3# RRD::File: a package for digging around in RRD files from Perl 4# 5# Copyright (C) 1998 Jeff R. Allen and WebTV Networks, Inc. 6# 7# This program is free software; you can redistribute it and/or modify 8# it under the terms of the GNU General Public License as published by 9# the Free Software Foundation; either version 2 of the License, or 10# (at your option) any later version. 11# 12# This program is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU General Public License for more details. 16# 17# You should have received a copy of the GNU General Public License 18# along with this program; if not, write to the Free Software 19# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 20 21package RRD::File; 22 23use strict; 24use Carp; 25use Config; 26use FileHandle; 27use RRDs; 28 29$RRD::File::gErr = ""; 30$RRD::File::gArch = $Config{'archname'}; 31 32# field setters/getters (gets value if no args, sets value and 33# returns old value if it does have an arg) 34 35sub file { shift->_getAndSet('file', @_) }; 36sub fh { shift->_getAndSet('fh', @_) }; 37sub fmt { shift->_getAndSet('format', @_) }; 38sub ds_cnt { shift->_getAndSet('ds_cnt', @_) }; 39sub rra_cnt { shift->_getAndSet('rra_cnt', @_) }; 40sub pdp_step { shift->_getAndSet('pdp_step', @_) }; 41sub cdp_xff { shift->_getAndSet('cdp_xff', @_) }; 42sub last_up { shift->_getAndSet('last_up', @_) }; 43sub info { shift->_getAndSet('info', @_) }; 44 45sub _getAndSet { 46 my($self, $field, $value) = @_; 47 my($retval) = $self->{$field}; 48 $self->{$field} = $value if ($#_ >= 2); 49 return $retval; 50} 51 52sub new { 53 my($type) = shift; 54 my(%p) = @_; 55 my($self) = {}; 56 $self->{'file'} = $p{'-file'}; 57 $self->{'fh'} = undef; 58 59 bless $self, $type; 60 return $self; 61} 62 63sub open { 64 my($self, $mode) = @_; 65 $mode = "<" if (! defined($mode)); 66 67 my($file) = $self->file(); 68 return unless defined($file); 69 70 my($fh) = new FileHandle; 71 72 if (! $fh->open($mode . $file)) { 73 $fh = undef; 74 } else { 75 binmode($fh); 76 } 77 78 close($fh) if $fh; 79 80 return 1; 81} 82 83sub close { 84 my($self) = @_; 85 1; 86} 87 88sub loadHeader { 89 my($self) = @_; 90 my($file) = $self->file(); 91 92 my($info) = RRDs::info($file); 93 94 if (!$info) { 95 $RRD::File::gErr = "Error reading RRD header: " . RRDs::error; 96 return; 97 } 98 99 $self->info($info); 100 101 # cdp_xff is only available with old format, but it's only 102 # accessed byu callers when they know it's going to be set, 103 # so it's OK if we set it tp undef here for new format RRD's. 104 105 my %DSdefs; 106 my %RRAdefs; 107 while (my ($key, $value) = each(%$info)) { 108 if ($key =~ /^ds\[(.*)\]\.(.*)$/) { 109 $value = fixName($value) if ($2 eq 'type'); 110 $DSdefs{fixName($1)}{$2} = $value; 111# warn "dsdefs{$1}{$2} = $value\n"; 112 } elsif ($key =~ /^rra\[(.*)\]\.(.*)$/) { 113 $RRAdefs{fixName($1)}{$2} = $value; 114# warn "rradefs{$1}{$2} = $value\n"; 115 } 116 } 117 118 $self->ds_cnt( scalar(keys %DSdefs) ); 119 $self->rra_cnt( scalar(keys %RRAdefs) ); 120 $self->pdp_step( $$info{'step'} ); 121 122 foreach my $dsName (keys %DSdefs) { 123 my $ds = $DSdefs{$dsName}; 124 my(%def) = (); 125 my $dsNum = ($dsName =~ /^ds(\d+)$/)[0]; 126 127 my($dst, $ds_mrhb, $min_val, $max_val, $value) = 128 ($$ds{type}, $$ds{minimal_heartbeat}, 129 $$ds{min}, $$ds{max}, $$ds{value}); 130 131 %def = ( 'dsName' => $dsName, 132 'dst' => $dst, 133 'ds_mrhb' => $ds_mrhb, 134 'min_val' => $min_val, 135 'max_val' => $max_val, 136 'value' => $value ); 137 138 $self->{'ds_def'}->[$dsNum] = \%def; 139 } 140 141 foreach my $rraName (keys %RRAdefs) { 142 my $rra = $RRAdefs{$rraName}; 143 my(%def) = (); 144 145 my($row_cnt, $pdp_cnt, $cf) = 146 ($$rra{rows}, $$rra{pdp_per_row}, $$rra{cf}); 147 148 $rraName = fixName($rraName); 149 $cf = fixName($cf); 150 151 %def = ( 'rraName' => $rraName, 152 'cf' => $cf, 153 'row_cnt' => $row_cnt, 154 'pdp_cnt' => $pdp_cnt ); 155 156 push @{$self->{'rra_def'}}, \%def; 157 } 158 159 $self->last_up($$info{last_update}); 160 161 foreach my $dsName (keys %DSdefs) { 162 my(%def) = (); 163 164 my($last_ds, $unkn_sec, $value) = 165 ($DSdefs{$dsName}{last_ds}, 166 $DSdefs{$dsName}{value}, 167 $DSdefs{$dsName}{unknown_sec}); 168 169 $last_ds = fixName($last_ds); 170 171 %def = ('last_ds' => $last_ds, 172 'value' => $value, 173 'unkn_sec' => $unkn_sec ); 174 175 push @{$self->{'pdps'}}, \%def; 176 } 177 178 return 1; 179} 180 181sub ds_def { 182 my($self, $i) = @_; 183 return $self->{'ds_def'}->[$i]; 184} 185 186sub rra_def { 187 my($self, $i) = @_; 188 return $self->{'rra_def'}->[$i]; 189} 190 191sub pdp { 192 my($self, $i) = @_; 193 return $self->{'pdps'}->[$i]; 194} 195 196sub cdp { 197 my($self, $i) = @_; 198 return $self->{'cdps'}->[$i]; 199} 200 201sub getDSCurrentValue { 202 my($self, $ds) = @_; 203 204 my($ds_cnt) = $self->ds_cnt(); 205 206 # check param, now that we have ds_cnt. 207 if (!defined($ds) || $ds >= $ds_cnt) { 208 return undef; 209 } 210 211 my ($start, $step, $names, $data) = RRDs::fetch($self->file(), 212 'AVERAGE', 213 '--start', 214 "now", 215 '--end', 216 "now"); 217 if (my $error = RRDs::error) { 218 Warn("getDSCurrentValue: fetch failed: $error"); 219 return undef; 220 } 221 my $ret = @{$data}[0]->[$ds]; 222 223 return 'NaN' unless defined($ret); 224 return $ret; 225} 226 227sub getMeta { 228 my($self) = @_; 229 my($metaRef) = {}; 230 231 my($file) = $self->file(); 232 return $metaRef unless defined($file); 233 234 # make the metafile name. Remove the .rrd (if there is one) 235 # and append .meta 236 $file =~ s/\.rrd$//; 237 my($metaFile) = "$file.meta"; 238 239 if (CORE::open(META, "<$metaFile")) { 240 while (<META>) { 241 chomp; 242 my($delim) = "\0"; 243 $delim = ":" if (! /\0/); # backwards compatiblity 244 my($k, $v) = split(/$delim/, $_, 2); 245 $metaRef->{$k} = $v; 246 } 247 CORE::close(META); 248 } 249 250 return $metaRef; 251} 252 253sub setMeta { 254 my($self, $metaRef) = @_; 255 256 my($file) = $self->file(); 257 return unless defined($file); 258 259 # make the metafile name. Remove the .rrd (if there is one) 260 # and append .meta 261 $file =~ s/\.rrd$//; 262 my($metaFile) = "$file.meta"; 263 264 if (CORE::open(META, ">$metaFile")) { 265 my($k); 266 foreach $k (keys(%{$metaRef})) { 267 print META join("\0", $k, $metaRef->{$k}), "\n"; 268 } 269 CORE::close(META); 270 271 return 1; 272 } else { 273 return; 274 } 275} 276 277sub fixName { 278 my($str) = @_; 279 280 # fix undefs (generated by old files) to be emtpy, so that 281 # we don't get warnings in rrd-dump 282 return "" unless defined ($str); 283 284 # even though unpack gives us all the bytes, we only want the C 285 # string. 286 my($nul) = index($str, "\0"); 287 if ($nul != -1) { 288 $str = substr($str, 0, $nul); 289 } 290 291 return $str; 292} 293 2941; 295 296# Local Variables: 297# mode: perl 298# indent-tabs-mode: nil 299# tab-width: 4 300# perl-indent-level: 4 301# cperl-indent-level: 4 302# End: 303