#!@PERL@
#  rrd_hwreapply - a script for re-applying Holt-Winters algorithm
#                     with tuned parameters
#
#  Copyright (C) 2002 Cablecom GmbH
#  Author: Stanislav Sinyagin <ssinyagin@yahoo.com>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

# $Id: rrd_hwreapply.in,v 1.2 2004/05/16 14:03:58 ssinyagin Exp $
#
#

# We need this for proper RRDs.pm path
use lib(@perllibdirs@);

use RRDs;
use Getopt::Long;
use Math::BigFloat;
use strict;

my ($force, $start, $delta, $deltapos, $deltaneg);
my ($failure_threshold, $window_length, $alpha, $beta);
my ($gamma, $gamma_deviation);
my ($hw_rra_length, $seasonal_period);
my $use_defaults;
my $hw_enabled = 0;  # This is true if the input RRD has HW arrays
my @DS;
my @RRA;
my @data_rras;
my %aberrant_rra;
my @ds_names;


my $OK = GetOptions ('force'                 => \$force,
                     'start=s'               => \$start,
                     'delta=f'               => \$delta,
                     'deltapos=f'            => \$deltapos,
                     'deltaneg=f'            => \$deltaneg,
                     'failure-threshold=i'   => \$failure_threshold,
                     'window-length=i'       => \$window_length,
                     'alpha=f'               => \$alpha,
                     'beta=f'                => \$beta,
                     'gamma=f'               => \$gamma,
                     'gamma-deviation=f'     => \$gamma_deviation,
                     'rralen=i'              => \$hw_rra_length,
                     'season=i'              => \$seasonal_period,
                     'defaults'              => \$use_defaults
);


my $rrdin = shift @ARGV;
my $rrdout = shift @ARGV;

if( not $OK or
    not $rrdin or
    not $rrdout or
    $#ARGV > -1 or
    not ( defined $use_defaults or
          defined $delta or
          defined $deltapos or
          defined $deltaneg or
          defined $failure_threshold or
          defined $window_length or
          defined $alpha or
          defined $beta or
          defined $gamma or
          defined $gamma_deviation or
          defined $hw_rra_length or
          defined $seasonal_period ) )
{
    print STDERR "\nScript for re-applying Holt-Winters algorithm\n";
    print STDERR "to an RRD with tuned parameters\n\n";
    print STDERR "Usage:\n";
    print STDERR "  $0 in.rrd out.rrd options...\n\n";
    print STDERR "Options:\n";
    print STDERR "       --force                force output file overwrite\n";
    print STDERR "       --start start          (default: oldest available)\n";
    print STDERR "       --delta scale-value\n";
    print STDERR "       --deltapos scale-value\n";
    print STDERR "       --deltaneg scale-value\n";
    print STDERR "       --failure-threshold failure-threshold\n";
    print STDERR "       --window-length window-length\n";
    print STDERR "       --alpha adaption-parameter\n";
    print STDERR "       --beta adaption-parameter\n";
    print STDERR "       --gamma adaption-parameter\n";
    print STDERR "       --gamma-deviation adaption-parameter\n";
    print STDERR "       --rralen rows          force HWPREDICT RRA length\n";
    print STDERR "       --season rows          force SEASONAL RRA length\n";
    print STDERR "       --defaults             force all default values\n";
    print STDERR "                              except explicit ones\n";
    print STDERR "Use --defaults when converting from non-HW database\n";
    exit;
}

die("Error accessing $rrdin: $!\n") unless -r $rrdin;

if( -r $rrdout and not $force )
{
    print STDERR "File exists: $rrdout. Use --force to overwrite\n";
    exit 1;
}

#######  Apply default values #########

if( $use_defaults )
{
    $alpha = 0.1;
    $beta  = 0.0035;
    $gamma = 0.1;
    $window_length = 9;
    $failure_threshold = 6;
    $hw_rra_length = 4032;
    $seasonal_period = 288;
}


#######  Analyze the input RRD #########

my $rrdinfo = RRDs::info( $rrdin );

## Collect RRA numbers

foreach my $prop (sort keys %$rrdinfo)
{
    my $propval = $rrdinfo->{$prop};

    if( $prop =~ /^ds\[(\S+)\]\.type/ )
    {
        push( @ds_names, $1 );
    }
    elsif( $prop =~ /^rra\[(\d+)\]\.(\S+)/ )
    {
        my $rranum = $1;
        my $rraprop = $2;

        if( $rraprop eq 'cf' )
        {
            if( grep {$propval eq $_} qw(AVERAGE MIN MAX LAST) )
            {
                push( @data_rras, $rranum );
            }
            elsif( grep {$propval eq $_} qw(HWPREDICT SEASONAL DEVSEASONAL
                                             DEVPREDICT FAILURES) )
            {
                $aberrant_rra{$propval} = $rranum;
                $hw_enabled = 1;
            }
        }
    }
}

## Verify the HW parameters

if( not $hw_enabled )
{
    if( not defined( $alpha ) or
        not defined( $beta ) or
        not defined( $gamma ) or
        not defined( $window_length ) or
        not defined( $failure_threshold ) or
        not defined( $hw_rra_length ) or
        not defined( $seasonal_period ) )
    {
        print STDERR "The input RRD is not Holt-Winters enabled, and not\n";
        print STDERR "all required parameters are specified. Perhaps you\n";
        print STDERR "should use --defaults option\n";
        exit 1;
    }
}

## Define the data sources

foreach my $ds_name ( @ds_names )
{
    my $type = $rrdinfo->{'ds['.$ds_name.'].type'};
    my $args = '';

    if( grep {$type eq $_} qw(GAUGE COUNTER DERIVE ABSOLUTE) )
    {
        my $min = $rrdinfo->{'ds['.$ds_name.'].min'};
        $min = 'U' unless $min;
        my $max = $rrdinfo->{'ds['.$ds_name.'].max'};
        $max = 'U' unless $max;

        $args = sprintf('%s:%s:%s',
                        $rrdinfo->{'ds['.$ds_name.'].minimal_heartbeat'},
                        $min, $max);
    }
    elsif( $type eq 'COMPUTE' )
    {
        $args = $rrdinfo->{'ds['.$ds_name.'].cdef'};
    }
    else
    {
        die("Unknown DS type: $type");
    }

    push( @DS, sprintf('DS:%s:%s:%s',
                       $ds_name, $type, $args) );
}

## Define the new 'traditional' RRAs

foreach my $rranum ( @data_rras )
{
    push( @RRA, sprintf('RRA:%s:%e:%d:%d',
                       $rrdinfo->{'rra['.$rranum.'].cf'},
                       $rrdinfo->{'rra['.$rranum.'].xff'},
                       $rrdinfo->{'rra['.$rranum.'].pdp_per_row'},
                       $rrdinfo->{'rra['.$rranum.'].rows'}));
}

## Define the RRAs for Holt-Winters prediction

my $hwpredict_rran = scalar(@data_rras) + 1;
my $seasonal_rran    = $hwpredict_rran + 1;
my $devseasonal_rran = $hwpredict_rran + 2;
my $devpredict_rran  = $hwpredict_rran + 3;
my $failures_rran    = $hwpredict_rran + 4;

if( not defined( $seasonal_period ) )
{
    $seasonal_period = $rrdinfo->{'rra['.$aberrant_rra{'SEASONAL'}.'].rows'};
}

my $rranum = $aberrant_rra{'HWPREDICT'};

$alpha = $rrdinfo->{'rra['.$rranum.'].alpha'} unless defined $alpha;
$beta = $rrdinfo->{'rra['.$rranum.'].beta'} unless defined $beta;
$hw_rra_length = $rrdinfo->{'rra['.$rranum.'].rows'} unless
    defined $hw_rra_length;

push( @RRA, sprintf('RRA:HWPREDICT:%d:%e:%e:%d:%d',
                    $hw_rra_length,
                    $alpha,
                    $beta,
                    $seasonal_period,
                    $seasonal_rran));

$rranum = $aberrant_rra{'SEASONAL'};

$gamma = $rrdinfo->{'rra['.$rranum.'].gamma'} unless defined $gamma;

push( @RRA, sprintf('RRA:SEASONAL:%d:%e:%d',
                    $seasonal_period,
                    $gamma,
                    $hwpredict_rran));

push( @RRA, sprintf('RRA:DEVSEASONAL:%d:%e:%d',
                    $seasonal_period,
                    $gamma,
                    $hwpredict_rran));

$rranum = $aberrant_rra{'DEVPREDICT'};

push( @RRA, sprintf('RRA:DEVPREDICT:%d:%d',
                    $hw_rra_length,
                    $devseasonal_rran));

$rranum = $aberrant_rra{'FAILURES'};

$failure_threshold = $rrdinfo->{'rra['.$rranum.'].failure_threshold'} unless
    defined $failure_threshold;

$window_length = $rrdinfo->{'rra['.$rranum.'].window_length'} unless
    defined $window_length;

push( @RRA, sprintf('RRA:FAILURES:%d:%d:%d:%d',
                    $hw_rra_length,
                    $failure_threshold,
                    $window_length,
                    $devseasonal_rran));

#######  Determine the oldest data available #######

if( not defined $start )
{
    my $last_update = $rrdinfo->{'last_update'};
    my $step = $rrdinfo->{'step'};
    $start = $last_update;

    my $finished = 0;
    my $idx = 0;
    while( not $finished and $idx < scalar( @data_rras ) )
    {
        $rranum = $data_rras[ $idx ];
        if( $rrdinfo->{'rra['.$rranum.'].pdp_per_row'} == 1 and
            $rrdinfo->{'rra['.$rranum.'].cf'} eq 'AVERAGE' )
        {
            my $nrows = $rrdinfo->{'rra['.$rranum.'].rows'};
            if( $last_update - ($step * $nrows) < $start )
            {
                $start = $last_update - ($step * $nrows);
            }
            $finished = 1;
        }
        $idx++;
    }

    printf STDERR ("Determined the earliest data available: %s (%d)\n",
                   scalar(localtime($start)), $start);
}

#######  Create the new RRD #######

my @cmdarg = ('--start='.$start,
              '--step='.$rrdinfo->{'step'},
              @DS, @RRA);

print STDERR "Creating $rrdout with arguments:\n", join("\n", @cmdarg), "\n";

RRDs::create($rrdout, @cmdarg);
my $ERR=RRDs::error;
die "ERROR while creating $rrdout: $ERR\n" if $ERR;

my @tunearg;
if( defined $delta )
{
    $deltapos = $delta;
    $deltaneg = $delta;
}
if( defined $deltapos )
{
    push( @tunearg, sprintf('--deltapos=%f', $deltapos) );
}
if( defined $deltaneg )
{
    push( @tunearg, sprintf('--deltaneg=%f', $deltaneg) );
}
if( defined $gamma_deviation )
{
    push( @tunearg, sprintf('--gamma-deviation=%f', $gamma_deviation) );
}

if( scalar( @tunearg ) > 0 )
{
    print STDERR "Tuning arguments: ", join(' ', @tunearg), "\n";
    &RRDs::tune( $rrdout, @tunearg );
    my $ERR=RRDs::error;
    die "ERROR while tuning $rrdout: $ERR\n" if $ERR;
}


#######  Copy the data from old RRD #######

print STDERR "Copying data from $rrdin to $rrdout\n";

my ($start,$step,$names,$data) =
    RRDs::fetch($rrdin, 'AVERAGE', '--start', $start);


####  Find out which DS'es are to be copied ####

my $template = '';
my $ds_idx = 0;
my %copy_ds;
my %ds_type;
my %prev_value;

foreach my $ds_name ( @$names )
{
    my $type = $ds_type{$ds_idx} = $rrdinfo->{'ds['.$ds_name.'].type'};
    if( $type ne 'COMPUTE' )
    {
        $copy_ds{$ds_idx} = 1;
        if( length( $template ) > 0 )
        {
            $template .= ':';
        }
        $template .= $ds_name;
    
        if( $type eq 'COUNTER' or $type eq 'DERIVE')
        {
            $prev_value{$ds_idx} =
                Math::BigFloat->new( $rrdinfo->{'ds['.$ds_name.'].last_ds'} );
        }
    }
    $ds_idx++;
}


####  Calculate the initial counter values ####

for( my $nLine = $#{$data}; $nLine >= 0; $nLine-- )
{
    my $line = $data->[$nLine];
    for( my $i = 0; $i < scalar(@{$line}); $i++ )
    {
        if( defined( $line->[$i] ) and $copy_ds{$i} )
        {
            my $type = $ds_type{$i};
            if( $type eq 'COUNTER' or $type eq 'DERIVE' )
            {
                $prev_value{$i} -= $line->[$i] * $step;
            }
        }
    }
}


my $ncopied = 0;

foreach my $line ( @{$data} )
{
    my $update = sprintf( '%d', $start );
    my $alldefined = 1;

    for( my $i = 0; $i < scalar(@{$line}); $i++ )
    {
        if( $copy_ds{$i} )
        {
            if( defined $line->[$i] )
            {
                my $wantInteger = 0;
                my $value;
                my $type = $ds_type{$i};
                if( $type eq 'GAUGE' )
                {
                    $value = $line->[$i];
                }
                elsif( $type eq 'COUNTER' or $type eq 'DERIVE')
                {
                    $wantInteger = 1;
                    $value = Math::BigFloat->new($line->[$i]) * $step;
                    if( defined( $prev_value{$i} ) )
                    {
                        $value += $prev_value{$i};
                    }
                    $prev_value{$i} = $value;
                }
                elsif( $type eq 'ABSOLUTE' )
                {
                    $value = $line->[$i] * $step;
                }
                else
                {
                    die("Unsupported DS type: $type");
                }

                if( $wantInteger )
                {
                    $update .= ':' . $value->ffround(0);
                }
                else
                {
                    $update .= ':' . $value;
                }                
            }
            else
            {
                $alldefined = 0;
            }
        }
    }

    if( $alldefined )
    {
        &RRDs::update( $rrdout, '--template='.$template, $update );
        my $ERR=RRDs::error;
        die "ERROR while updating $rrdout: $ERR\n" if $ERR;
        $ncopied++;
    }
    $start += $step;
}

printf STDERR ("Copied %d rows\n", $ncopied);

# Local Variables:
# mode: perl
# indent-tabs-mode: nil
# perl-indent-level: 4
# End: