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