torrus/perllib/Torrus/DataAccess.pm

   1 #  Copyright (C) 2002  Stanislav Sinyagin
   2 #
   3 #  This program is free software; you can redistribute it and/or modify
   4 #  it under the terms of the GNU General Public License as published by
   5 #  the Free Software Foundation; either version 2 of the License, or
   6 #  (at your option) any later version.
   7 #
   8 #  This program is distributed in the hope that it will be useful,
   9 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #  GNU General Public License for more details.
  12 #
  13 #  You should have received a copy of the GNU General Public License
  14 #  along with this program; if not, write to the Free Software
  15 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # $Id: DataAccess.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20 package Torrus::DataAccess;
  21
  22 use Torrus::ConfigTree;
  23 use Torrus::Log;
  24 use Torrus::RPN;
  25
  26 use strict;
  27 use RRDs;
  28
  29 # The Torrus::DataAccess object contains cached values, and it does not
  30 # check the cache validity. We assume that a Torrus::DataAccess object
  31 # lifetime is within a short period of time, such as one monitor cycle.
  32
  33 sub new
  34 {
  35     my $self = {};
  36     my $class = shift;
  37     bless $self, $class;
  38     return $self;
  39 }
  40
  41 # Read the data from datasource file, depending on its type.
  42 # If time is not specified, reads the latest available data.
  43 # In case of rrd-cdef leaf type, the returned timestamp is the
  44 # earliest timestamp of the data sources involved.
  45 #
  46 # ($value, $timestamp) = $da->read( $config_tree, $leaf_token )
  47 #
  48 # ($value, $timestamp) = $da->read( $config_tree, $leaf_token, $end_time )
  49 #
  50 # ($value, $timestamp) = $da->read( $config_tree, $leaf_token,
  51 #                                   $end_time, $start_time )
  52
  53
  54 sub read
  55 {
  56     my $self = shift;
  57     my $config_tree = shift;
  58     my $token = shift;
  59     my $t_end = shift;
  60     my $t_start = shift;
  61
  62     my $cachekey = $token .
  63         ':' . (defined($t_end)?$t_end:'') .
  64         ':' . (defined($t_start)?$t_start:'');
  65
  66     if( exists( $self->{'cache_read'}{$cachekey} ) )
  67     {
  68         return @{$self->{'cache_read'}{$cachekey}};
  69     }
  70
  71     if( not $config_tree->isLeaf( $token ) )
  72     {
  73         my $path = $config_tree->path( $token );
  74         Error("Torrus::DataAccess::readLast: $path is not a leaf");
  75         return undef;
  76     }
  77
  78     my $ret_val;
  79     my $ret_time;
  80
  81     my $ds_type = $config_tree->getNodeParam( $token, 'ds-type' );
  82     if( $ds_type eq 'rrd-file' or
  83         $ds_type eq 'collector' )
  84     {
  85         my $leaf_type = $config_tree->getNodeParam( $token, 'leaf-type' );
  86
  87         if( $leaf_type eq 'rrd-def' )
  88         {
  89             my $file = $config_tree->getNodeParam( $token, 'data-file' );
  90             my $dir = $config_tree->getNodeParam( $token, 'data-dir' );
  91             my $ds = $config_tree->getNodeParam( $token, 'rrd-ds' );
  92             my $cf = $config_tree->getNodeParam( $token, 'rrd-cf' );
  93             ( $ret_val, $ret_time ) =
  94                 $self->read_RRD_DS( $dir.'/'.$file,
  95                                     $cf, $ds, $t_end, $t_start );
  96         }
  97         elsif( $leaf_type eq 'rrd-cdef' )
  98         {
  99             my $expr = $config_tree->getNodeParam( $token, 'rpn-expr' );
 100             ( $ret_val, $ret_time ) =
 101                 $self->read_RPN( $config_tree, $token, $expr,
 102                                  $t_end, $t_start );
 103
 104         }
 105         else
 106         {
 107             my $path = $config_tree->path( $token );
 108             Error("$path: leaf-type $leaf_type is not supported ".
 109                   "for data access");
 110         }
 111     }
 112     else
 113     {
 114         my $path = $config_tree->path( $token );
 115         Error("$path: ds-type $ds_type is not supported ".
 116               "for data access");
 117     }
 118
 119     $self->{'cache_read'}{$cachekey} = [ $ret_val, $ret_time ];
 120     return ( $ret_val, $ret_time );
 121 }
 122
 123
 124 sub read_RRD_DS
 125 {
 126     my $self = shift;
 127     my $filename = shift;
 128     my $cf = shift;
 129     my $ds = shift;
 130     my $t_end = shift;
 131     my $t_start = shift;
 132
 133     my $cachekey = $filename . ':' . $cf .
 134         ':' . (defined($t_end)?$t_end:'') .
 135         ':' . (defined($t_start)?$t_start:'');
 136
 137     if( exists( $self->{'cache_RRD'}{$cachekey}{$ds} ) )
 138     {
 139         return @{$self->{'cache_RRD'}{$cachekey}{$ds}};
 140     }
 141
 142     my $rrdinfo = RRDs::info( $filename );
 143     my $ERR = RRDs::error;
 144     if( $ERR )
 145     {
 146         Error("Error during RRD info for $filename: $ERR");
 147         return undef;
 148
 149     }
 150     my $step = $rrdinfo->{'step'};
 151     my $last_available = $rrdinfo->{'last_update'};
 152     $last_available -= $last_available % $step;
 153
 154     if( not defined $t_end )
 155     {
 156         $t_end = $last_available;
 157     }
 158     elsif( index( $t_end, 'LAST' ) >= 0 )
 159     {
 160         $t_end =~ s/LAST/$last_available/g;
 161     }
 162
 163     if( not defined $t_start )
 164     {
 165         $t_start = $t_end . '-' . int($step * 3);
 166     }
 167     elsif( index( $t_start, 'LAST' ) >= 0 )
 168     {
 169         $t_start =~ s/LAST/$last_available/g;
 170     }
 171
 172     # From here on, f_ prefix means fetch results
 173     my( $f_start, $f_step, $f_names, $f_data ) =
 174         RRDs::fetch( $filename, $cf, '--start', $t_start, '--end', $t_end );
 175     $ERR = RRDs::error;
 176     if( $ERR )
 177     {
 178         Error("Error during RRD fetch for $filename: $ERR");
 179         return undef;
 180
 181     }
 182
 183     # Memorize the DS names in cache
 184
 185     for( my $i = 0; $i < @{$f_names}; $i++ )
 186     {
 187         $self->{'cache_RRD'}{$cachekey}{$f_names->[$i]} = [];
 188     }
 189
 190     # Get the last available data and store in cache
 191
 192     foreach my $f_line ( @{$f_data} )
 193     {
 194         for( my $i = 0; $i < @{$f_names}; $i++ )
 195         {
 196             if( defined $f_line->[$i] )
 197             {
 198                 $self->{'cache_RRD'}{$cachekey}{$f_names->[$i]} =
 199                     [ $f_line->[$i], $f_start ];
 200             }
 201         }
 202         $f_start += $f_step;
 203     }
 204
 205     if( not exists( $self->{'cache_RRD'}{$cachekey}{$ds} ) )
 206     {
 207         Error("DS name $ds is not found in $filename");
 208         return undef;
 209     }
 210     else
 211     {
 212         if( scalar( @{$self->{'cache_RRD'}{$cachekey}{$ds}} ) == 0 )
 213         {
 214             Warn("Value undefined for ",
 215                  "DS=$ds, CF=$cf, start=$t_start, end=$t_end in $filename");
 216             return undef;
 217         }
 218         else
 219         {
 220             return @{$self->{'cache_RRD'}{$cachekey}{$ds}};
 221         }
 222     }
 223 }
 224
 225
 226
 227 # Data access for other CF than defined for the leaf doesn't make much
 228 # sense. So we ignore the CF in DataAccess and leave it for the
 229 # sake of Renderer compatibility
 230 my %cfNames =
 231     ( 'AVERAGE' => 1,
 232       'MIN'     => 1,
 233       'MAX'     => 1,
 234       'LAST'    => 1 );
 235
 236
 237 sub read_RPN
 238 {
 239     my $self = shift;
 240     my $config_tree = shift;
 241     my $token = shift;
 242     my $expr = shift;
 243     my $t_end = shift;
 244     my $t_start = shift;
 245
 246     my @expr_list = split(',', $expr);
 247     my @eval_expr;
 248     my $timestamp = $t_end > 0 ? $t_end : time();
 249
 250     my $rpn = new Torrus::RPN;
 251
 252     my $callback = sub
 253     {
 254         my ($noderef, $timeoffset) = @_;
 255
 256         my $function;
 257         if( $noderef =~ s/^(.)\@// )
 258         {
 259             $function = $1;
 260         }
 261
 262         my $leaf = length($noderef) > 0 ?
 263             $config_tree->getRelative($token, $noderef) : $token;
 264
 265         if( not defined $leaf )
 266         {
 267             my $path = $config_tree->path($token);
 268             Error("Cannot find relative reference $noderef at $path");
 269             return undef;
 270         }
 271
 272         my ($rval, $var_tstamp) = $self->read($config_tree,
 273                                               $leaf,
 274                                               $timeoffset,
 275                                               $t_start);
 276         if( defined $rval )
 277         {
 278             if( $var_tstamp == 0 )
 279             {
 280                 Warn("Torrus::DataAccess::read retirned zero timestamp ".
 281                      "for $leaf");
 282             }
 283
 284             if( $var_tstamp < $timestamp )
 285             {
 286                 $timestamp = $var_tstamp;
 287             }
 288         }
 289
 290         if( defined( $function ) )
 291         {
 292             if( $function eq 'T' )
 293             {
 294                 return $var_tstamp;
 295             }
 296             elsif( not $cfNames{$function} )
 297             {
 298                 Error("Function not supported in RPN: $function");
 299                 return undef;
 300             }
 301         }
 302         return $rval;
 303     };
 304
 305     my $result = $rpn->run( $expr, $callback );
 306
 307     return ( $result, $timestamp );
 308 }
 309
 310 1;
 311
 312
 313 # Local Variables:
 314 # mode: perl
 315 # indent-tabs-mode: nil
 316 # perl-indent-level: 4
 317 # End: