view release on metacpan or  search on metacpan

lib/GrowthForecast/RRD.pm  view on Meta::CPAN

        push(@param, "DS:sub:${dst}:600:U:U");
    }
    return @param;
}

sub path {
    my $self = shift;
    my $data = shift;

    my $file = $self->{data_dir} . '/' . $data->{md5} . '.rrd';
    if ( ! -f $file ) {
        eval {
            my @param = $self->path_param($data);
            RRDs::create($file, @param);
            my $ERR=RRDs::error;
            die $ERR if $ERR;
        };
        die "init failed: $@" if $@;
    }
    $file;
}

sub path_short_param {
    my $self = shift;
    my $data = shift;

    my $dst = $data->{mode} eq 'derive' ? 'DERIVE' : 'GAUGE';
    my $timestamp = $data->{timestamp} || time;

    my @param = (
        '--start', $timestamp - 10, # -10 as rrdcreate's default does (now - 10s)
        '--step', '60',
        "DS:num:${dst}:120:U:U",
        'RRA:AVERAGE:0.5:1:4800',  #1分, 3日(80時間)
        'RRA:MAX:0.5:1:4800',  #1分, 3日(80時間)
    );
    unless ( $self->{disable_subtract} ) {
        # --disable-subtract does not create DS:sub which results in half disksize and half rrdupdate time
        push(@param, "DS:sub:${dst}:120:U:U");
    }
    return @param;
}

sub path_short {
    my $self = shift;
    my $data = shift;

    my $file = $self->{data_dir} . '/' . $data->{md5} . '_s.rrd';
    if ( ! -f $file ) {
        eval {
            my @param = $self->path_short_param($data);
            RRDs::create($file, @param);
            my $ERR=RRDs::error;
            die $ERR if $ERR;
        };
        die "init failed: $@" if $@;
    }
    $file;
}

sub update_param {
    my $self = shift;
    my $data = shift;

    my @param;
    my $timestamp = $data->{timestamp} || 'N';
    if ( $self->{disable_subtract} ) {
        @param = (
            '-t', 'num',
            '--', join(':',$timestamp,$data->{number}),
        );
    }
    else {
        @param = (
            '-t', 'num:sub',
            '--', join(':',$timestamp,$data->{number},$data->{subtract}),
        );
    }
    if ( $self->{rrdcached} ) {
        # The caching daemon cannot be used together with templates (-t) yet.
        splice(@param, 0, 2); # delete -t option
        unshift(@param, '-d', $self->{rrdcached});
    }
    return @param;
}

sub update {
    my $self = shift;
    my $data = shift;

    my $file = $self->path($data);
    eval {
        my @param = $self->update_param($data);
        RRDs::update($file, @param);
        my $ERR=RRDs::error;
        if ( $ERR ) {
            if ( $ERR =~ /illegal attempt to update using time.*when last update time is.*minimum one second step/ ) {
                debugf "update rrdfile failed: $ERR";
            }
            else {
                die $ERR;
            }
        }
    };
    die "udpate rrdfile failed: $@" if $@;
}

sub update_short_param {
    my $self = shift;
    my $data = shift;

    my @param;
    my $timestamp = $data->{timestamp} || 'N';
    if ( $self->{disable_subtract} ) {
        @param = (
            '-t', 'num',
            '--', join(':',$timestamp,$data->{number}),
        );
    }
    else {
        @param = (
            '-t', 'num:sub',
            '--', join(':',$timestamp,$data->{number},$data->{subtract_short}),
        );
    }
    if ( $self->{rrdcached} ) {
        # The caching daemon cannot be used together with templates (-t) yet.
        splice(@param, 0, 2); # delete -t option
        unshift(@param, '-d', $self->{rrdcached});
    }
    return @param;
}

sub update_short {
    my $self = shift;
    my $data = shift;

    my $file = $self->path_short($data);
    eval {
        my @param = $self->update_short_param($data);
        RRDs::update($file, @param);
        my $ERR=RRDs::error;
        if ( $ERR ) {
            if ( $ERR =~ /illegal attempt to update using time.*when last update time is.*minimum one second step/ ) {
                debugf "update rrdfile failed: $ERR";
            }
            else {
                die $ERR;
            }
        }
    };
    die "udpate rrdfile failed: $@" if $@;
}

sub calc_period {
    my $self = shift;
    my ($span, $from, $to) = @_;
    $span ||= 'd';

    my $period_title;
    my $period;
    my $end = 'now';
    my $xgrid;

    if ( $span eq 'c' || $span eq 'sc' ) {
        my $from_time = HTTP::Date::str2time($from);  
        die "invalid from date: $from" unless $from_time;
        my $to_time = $to ? HTTP::Date::str2time($to) : time;
        die "invalid to date: $to" unless $to_time;
        die "from($from) is newer than to($to)" if $from_time > $to_time;

        $period_title = "$from to $to" ;
        $period = $from_time;
        $end = $to_time;
        my $diff = $to_time - $from_time;
        if ( $diff < 3 * 60 * 60 ) {
            $xgrid = 'MINUTE:10:MINUTE:20:MINUTE:10:0:%M';
        }
        elsif ( $diff < 4 * 24 * 60 * 60 ) {
            $xgrid = 'HOUR:6:DAY:1:HOUR:6:0:%H';
        }
        elsif ( $diff < 14 * 24 * 60 * 60) {
            $xgrid = 'DAY:1:DAY:1:DAY:2:86400:%m/%d';
        }
        elsif ( $diff < 45 * 24 * 60 * 60) {
            $xgrid = 'DAY:1:WEEK:1:WEEK:1:0:%F';
        }
        else {
            $xgrid = 'WEEK:1:MONTH:1:MONTH:1:2592000:%b';
        }
    }
    elsif ( $span eq 'h' || $span eq 'sh' ) {
        $period_title = 'Hour (5min avg)';
        $period_title = 'Hour (1min avg)' if $span eq 'sh';