torrus/perllib/Torrus/SchedulerInfo.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: SchedulerInfo.pm,v 1.1 2010-12-27 00:03:43 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20
  21 # Task scheduler runtime information. Quite basic statistics access.
  22
  23 package Torrus::SchedulerInfo;
  24
  25 use Torrus::DB;
  26 use Torrus::Log;
  27 use strict;
  28
  29
  30 sub new
  31 {
  32     my $self = {};
  33     my $class = shift;
  34     my %options = @_;
  35     bless $self, $class;
  36
  37     %{$self->{'options'}} = %options;
  38
  39     die() if not defined( $options{'-Tree'} );
  40
  41     $self->{'db_stats'} =
  42         new Torrus::DB( 'scheduler_stats',
  43                       -Subdir => $self->{'options'}{'-Tree'},
  44                       -Btree => 1,
  45                       -WriteAccess => $options{'-WriteAccess'} );
  46
  47     return( defined( $self->{'db_stats'} ) ? $self:undef );
  48 }
  49
  50
  51 sub DESTROY
  52 {
  53     my $self = shift;
  54     delete $self->{'db_stats'};
  55 }
  56
  57
  58 sub readStats
  59 {
  60     my $self = shift;
  61
  62     my $stats = {};
  63
  64     my $cursor = $self->{'db_stats'}->cursor();
  65     while( my ($key, $value) = $self->{'db_stats'}->next($cursor) )
  66     {
  67         my( $id, $variable ) = split( '#', $key );
  68         if( defined( $id ) and defined( $variable ) )
  69         {
  70             $stats->{$id}{$variable} = $value;
  71         }
  72     }
  73     undef $cursor;
  74
  75     return $stats;
  76 }
  77
  78
  79 sub setValue
  80 {
  81     my $self = shift;
  82     my $id = shift;
  83     my $variable = shift;
  84     my $value = shift;
  85
  86     $self->{'db_stats'}->put( join('#', $id, $variable), $value );
  87 }
  88
  89 sub getValue
  90 {
  91     my $self = shift;
  92     my $id = shift;
  93     my $variable = shift;
  94
  95     return $self->{'db_stats'}->get( join('#', $id, $variable) );
  96 }
  97
  98
  99 sub clearStats
 100 {
 101     my $self = shift;
 102     my $id = shift;
 103
 104     my $cursor = $self->{'db_stats'}->cursor( -Write => 1 );
 105     while( my ($key, $value) = $self->{'db_stats'}->next($cursor) )
 106     {
 107         my( $db_id, $variable ) = split( '#', $key );
 108         if( defined( $db_id ) and defined( $variable ) and
 109             $id eq $db_id )
 110         {
 111             $self->{'db_stats'}->c_del( $cursor );
 112         }
 113     }
 114     undef $cursor;
 115 }
 116
 117
 118 sub clearAll
 119 {
 120     my $self = shift;
 121     $self->{'db_stats'}->trunc();
 122 }
 123
 124
 125 sub setStatsValues
 126 {
 127     my $self = shift;
 128     my $id = shift;
 129     my $variable = shift;
 130     my $value = shift;
 131
 132     $self->setValue( $id, 'Last' . $variable, $value );
 133
 134     my $maxName = 'Max' . $variable;
 135     my $maxVal = $self->getValue( $id, $maxName );
 136     if( not defined( $maxVal ) or $value > $maxVal )
 137     {
 138         $maxVal = $value;
 139     }
 140     $self->setValue( $id, $maxName, $maxVal );
 141
 142     my $minName = 'Min' . $variable;
 143     my $minVal = $self->getValue( $id, $minName );
 144     if( not defined( $minVal ) or $value < $minVal )
 145     {
 146         $minVal = $value;
 147     }
 148     $self->setValue( $id, $minName, $minVal );
 149
 150     my $timesName = 'NTimes' . $variable;
 151     my $nTimes = $self->getValue( $id, $timesName );
 152
 153     my $avgName = 'Avg' . $variable;
 154     my $average = $self->getValue( $id, $avgName );
 155
 156     if( not defined( $nTimes ) )
 157     {
 158         $nTimes = 1;
 159         $average = $value;
 160     }
 161     else
 162     {
 163         $average = ( $average * $nTimes + $value ) / ( $nTimes + 1 );
 164         $nTimes++;
 165     }
 166     $self->setValue( $id, $timesName, $nTimes );
 167     $self->setValue( $id, $avgName, $average );
 168
 169     my $expAvgName = 'ExpAvg' . $variable;
 170     my $expAverage = $self->getValue( $id, $expAvgName );
 171     if( not defined( $expAverage ) )
 172     {
 173         $expAverage = $value;
 174     }
 175     else
 176     {
 177         my $alpha = $Torrus::Scheduler::statsExpDecayAlpha;
 178         $expAverage = $alpha * $value + ( 1 - $alpha ) * $expAverage;
 179     }
 180     $self->setValue( $id, $expAvgName, $expAverage );
 181 }
 182
 183
 184 sub incStatsCounter
 185 {
 186     my $self = shift;
 187     my $id = shift;
 188     my $variable = shift;
 189     my $increment = shift;
 190
 191     if( not defined( $increment ) )
 192     {
 193         $increment = 1;
 194     }
 195
 196     my $name = 'Count' . $variable;
 197     my $previous = $self->getValue( $id, $name );
 198
 199     if( not defined( $previous ) )
 200     {
 201         $previous = 0;
 202     }
 203
 204     $self->setValue( $id, $name, $previous + $increment );
 205 }
 206
 207
 208
 209 1;
 210
 211
 212 # Local Variables:
 213 # mode: perl
 214 # indent-tabs-mode: nil
 215 # perl-indent-level: 4
 216 # End: