initial release

git-svn-id: svn://svn.oetiker.ch/rrdtool/trunk@2025 a5681a0c-68f1-0310-ab6d-d61299d08faa

diff --git a/contrib/rrdjig/rrdjig.pl b/contrib/rrdjig/rrdjig.pl
new file mode 100755 (executable)
index 0000000..b5ba928
--- /dev/null
+++ b/contrib/rrdjig/rrdjig.pl
@@ -0,0 +1,400 @@
+#!/usr/bin/perl -w
+require 5.008;
+use lib qw(/scratch/rrd-1.4.3-test2/lib/perl);
+use RRDs;
+use strict;
+use Getopt::Long 2.25 qw(:config posix_default no_ignore_case);
+use Pod::Usage 1.14;
+use Data::Dumper;
+
+'$Revision$ ' =~ /Revision: (\S*)/;
+my $Revision = $1;
+
+# main loop
+my %opt = ();
+sub main()
+{
+    # parse options
+    GetOptions(\%opt, 'help|h', 'man', 'version', 'noaction|no-action|n',
+        'verbose|v','src-tmpl=s','dst-tmpl=s') or exit(1);
+    if($opt{help})     { pod2usage(1) }
+    if($opt{man})      { pod2usage(-exitstatus => 0, -verbose => 2) }
+    if($opt{version})  { print "rrdjig $Revision\n"; exit(0) }
+    my $src = shift @ARGV or pod2usage(1);
+    if (not -r $src)   { pod2usage("Reading $src: $!") }
+    my $dst = shift @ARGV or pod2usage(1);
+    if (not -w $dst)   { pod2usage("Accessing $dst: $!") }
+
+    rrdjig($src,$opt{'src-tmpl'},$dst,$opt{'dst-tmpl'});
+}
+
+main;
+
+sub rrd_err_check(){
+    my $err = RRDs::error();
+    if ($err){
+        die "RRD Error: $err\n";
+    }
+}
+
+# how should the data be fetched from the source
+# to provide the best approximation of the original data
+
+sub step_sync ($$){
+    my $value = shift;
+    my $step = shift;
+    return ($value - ($value % $step));
+}
+
+sub get_rra_size_map($){
+    my $info = shift;    
+    my $map = {};
+    my $min_start;
+    for (my $i=0;;$i++){
+        my $cf = $info->{"rra[$i].cf"};
+        last if not $cf;
+        next if $cf !~ /AVERAGE|MIN|MAX/;
+        my $pdp_per_row = $info->{"rra[$i].pdp_per_row"};
+        next if $cf =~ /MIN|MAX/ and $pdp_per_row == 1;
+        my $rows = $info->{"rra[$i].rows"};
+        my $step = $pdp_per_row*$info->{step};
+        my $start = step_sync($info->{last_update},$step) - $step*$rows;
+        if (not defined $min_start or $start < $min_start) {
+            $min_start = $start;
+        }
+        if (  $map->{$cf}{$pdp_per_row}{rows} || 0 < $rows
+            or $map->{$cf}{$pdp_per_row}{start} || 0 < $start ){
+            $map->{$cf}{$pdp_per_row} = {
+                id   => $i,
+                rows => $rows,
+                step => $step,
+                start => $start
+            };
+        }
+    }
+    return ($min_start,$map);
+}
+
+
+sub prep_fetch_tasks ($$){
+    my $src_info = shift;
+    my $dst_info = shift;
+    my ($min_start,$src_size) = get_rra_size_map($src_info);
+    my $now = step_sync($src_info->{last_update}, $src_info->{step});
+    my $first = step_sync($dst_info->{last_update} , $dst_info->{step});
+    if ($min_start > $first ) {
+        $first = $min_start;
+    }
+    print "Search $first to $now\n" if $opt{verbose};
+    my $task = {};
+    for my $cf (qw(AVERAGE MIN MAX)){
+        my $x = $src_size->{$cf};
+        my $pointer = $now;
+        $task->{$cf} = [];
+        for my $pdp_per_row (sort {$a <=> $b} keys %$x){
+            my $step = $x->{$pdp_per_row}{step};
+            my $new_pointer = $x->{$pdp_per_row}{start};
+            print "look $cf $pdp_per_row * $step - $new_pointer\n" if $opt{verbose};
+            if ($new_pointer <= $first){
+                $new_pointer = step_sync($first,$step);
+            }
+            if ($new_pointer <= $pointer){
+                unshift @{$task->{$cf}}, {
+                    start => $new_pointer,
+                    end => step_sync($pointer,$step),
+                    step => $step
+                };
+                $pointer = $new_pointer;
+            }
+            last if $pointer <= $first;
+        }
+    }
+    return ($first,$task);
+}
+
+sub fetch_data($$$){
+    my $src = shift;
+    my $first = shift;
+    my $tasks = shift;
+    my %data;
+    my @tmpl;
+    if ($opt{'src-tmpl'}){
+        @tmpl = split /:/, $opt{'src-tmpl'};
+    }
+    my %map;
+    for my $cf (keys %$tasks){
+        print STDERR "FETCH #### CF $cf #####################################\n" 
+            if $opt{verbose};
+        for my $t (@{$tasks->{$cf}}){
+            my ($start,$step,$names,$array) = RRDs::fetch(
+                $src,$cf,'--resolution',$t->{step},
+                '--start',$t->{start},'--end',$t->{end}
+            );
+            my $id = 0;
+            if (@tmpl and not %map){
+                %map = ( map { ($_,$id++) } @$names );
+                for my $key (@tmpl){
+                    die "ERROR: src key '$key' is not known in $src. Pick from ".join(':',@$names)."\n"
+                        if not exists $map{$key};
+                }
+            }
+            rrd_err_check();
+            print STDERR "FETCH: want setp $t->{step} -> got step $step  / want start $t->{start} -> got start $start\n" if $opt{verbose};
+            my $now = $start;                        
+            while (my $row = shift @$array){
+                if (@tmpl){
+                    push @{$data{$cf}} , [ $now, $step, [ @$row[@map{@tmpl}] ] ];
+                }
+                else {
+                    push @{$data{$cf}} , [ $now, $step, $row ];
+                }
+                $now+=$step;
+            }
+        }
+    }
+    die "ERROR: no AVERAGE RRA found in src rrd. Enhance me to be able to deal with this!\n"
+        if not $data{AVERAGE};
+    # if older data is required, generate a fake average entry.
+    my $start = $data{AVERAGE}[0][0] - $data{AVERAGE}[0][1];
+    if ($start > $first ) {
+        my $step = $start - $first;
+        unshift @{$data{AVERAGE}}, [ $start, $step, [ map {undef} @{$data{AVERAGE}[0][2]} ] ];
+    }
+    return \%data;
+}
+
+sub reupdate($$$){
+    my $step = shift;
+    my $dst = shift;
+    my $data = shift;
+    my @hidden_rows;
+    my @fake_rows;
+    my @up;
+    while (my $av = shift @{$data->{AVERAGE}}){
+        my $end = $av->[0];
+        my $start = $end - $av->[1];
+        if (my $av_nx = $data->{AVERAGE}[0]){
+            my $start_nx = $av_nx->[0] - $av_nx->[1];
+            if ($end > $start_nx){
+                $end = $start_nx;
+            }
+        }
+        STEP:
+        for (my $t = $start+$step;$t<=$end;$t+=$step){
+            my @out = @{$av->[2]};
+            # lets see if we a usable a MIN or MAX entry pending
+            if (@hidden_rows < 2 and $av->[1] > $step) {
+                for my $cf (qw(MIN MAX)){
+                    my $m = $data->{$cf}[0];
+                    # drop any MIN/MAX entries which we could not use
+                    while ($m->[0] <= $start) {
+                        print STDERR "# DROP $cf $m->[0], $m->[1]\n" if $opt{verbose};
+                        shift @{$data->{$cf}};
+                        $m = $data->{$cf}[0];
+                    }
+                    my $cend = $m->[0];
+                    my $cstep = $m->[1];
+                    my $crow = $m->[2];
+                    if ($cend >= $t and $cend- $cstep <= $t - $step){
+                        my $row = "$t:".join(':',map {defined $_ ? $_ : 'U'} @{$crow});
+                        print STDERR ($cf eq 'MIN' ? 'm' : 'M' ) ,$row,"\n" if $opt{verbose};
+                        push @up, $row;
+                        push @hidden_rows, $av->[2];
+                        push @fake_rows, $crow;
+                        shift @{$data->{$cf}};
+                        next STEP;
+                    }
+                }
+            }
+            # compensate for the AVERAGE data NOT shown
+            while (my $row = shift @hidden_rows){
+                for (my $i = 0; $i <@$row; $i++){
+                    if (not defined  $row->[$i] or not defined $out[$i]){
+                       $out[$i] = undef;
+                    } else {
+                       $out[$i] += $row->[$i];
+                    }
+                }
+            }
+            # compensate for the MIN/MAX data shown INSTEAD
+            while (my $row = shift @fake_rows){
+                for (my $i = 0; $i <@$row; $i++){
+                    if (not defined  $row->[$i] or not defined $out[$i]){
+                       $out[$i] = undef;
+                    } else {
+                       $out[$i] -= $row->[$i];
+                    }
+                }
+            }
+            # show the result;            
+            my $row = "$t:".join(':',map {defined $_ ? $_ : 'U'} @out);
+            print STDERR " ",$row,"\n" if $opt{verbose};
+            push @up, $row;
+        }
+    }
+    pop @up; # the last update is most likely one too many ...
+    if (@up == 0) {
+        warn "WARNING: src has no entries new enough to fill dst\n";
+    } else {
+        RRDs::update($dst,
+                     $opt{'dst-tmpl'} ? '--template='.$opt{'dst-tmpl'} : (),
+                     @up);
+        rrd_err_check();
+    }
+}
+
+sub set_gauge($$){
+    my $dst = shift;
+    my $info = shift;
+    my @tasks;
+    for my $key (keys %$info) {
+        if ($key =~ m/^ds\[(.+)\]\.type$/
+            and $info->{$key} ne 'GAUGE'){
+            print STDERR "DS $1 -> GAUGE\n" if $opt{verbose};
+            push @tasks, "--data-source-type=${1}:GAUGE";
+        }
+        if (@tasks) {
+            RRDs::tune($dst,@tasks);
+            rrd_err_check();
+        }
+    }
+}
+
+sub unset_gauge($$){
+    my $dst = shift;
+    my $info = shift;
+    my @tasks;
+    for my $key (keys %$info) {
+        if ($key =~ m/^ds\[(.+)\]\.type$/
+            and $info->{$key} ne 'GAUGE'){
+            print STDERR "DS $1 -> $info->{$key}\n" if $opt{verbose};
+            push @tasks, "--data-source-type=${1}:$info->{$key}";
+        }
+        if (@tasks) {
+            RRDs::tune($dst,@tasks);
+            rrd_err_check();
+        }
+    }
+}
+
+sub rrdjig($$$$){
+    my $src = shift;
+    my $src_tmpl = shift;
+    my $dst = shift;
+    my $dst_tmpl = shift;
+    my $dst_info = RRDs::info($dst);
+    rrd_err_check();    
+    my $src_info = RRDs::info($src);
+    rrd_err_check();
+    my ($first,$fetch_tasks) = prep_fetch_tasks($src_info,$dst_info);
+    my $updates = fetch_data($src,$first,$fetch_tasks);
+    set_gauge($dst,$dst_info);
+    reupdate($src_info->{step},$dst,$updates);
+    unset_gauge($dst,$dst_info);
+}
+
+
+__END__
+
+=head1 NAME
+
+rrdjig - use data from an existing rrd file to populate a new one
+
+=head1 SYNOPSIS
+
+B<rrdjig> [I<options>...] I<src.rrd> I<dest.rrd>
+
+     --man           show man-page and exit
+ -h, --help          display this help and exit
+     --version       show version information and exit
+     --verbose       talk while you work
+     --noaction      just talk don't act
+     --src-tmpl=tmpl output template for the source rrd
+     --dst-tmpl=tmpl input template for the destination rrd
+
+=head1 DESCRIPTION
+
+In rrdtool, data gets processed immediately upon arrival. This means that
+the original data is never stored and it is thus not easily possible to
+restructure data at a later stage. In the rrdtool core there are no
+functions to modify the base step size nor the number and types of RRAs in a
+graceful manner.
+
+The rrdjig tool tries to rebild the original data as closely as possible
+based on the data found in the rrd file. It takes AVERAGE, MIN and MAX RRAs
+into account and rebilds the original data stream such that it can be
+re-enterd into a fresh rrd file. Depending on the configuration of the new
+rrd file the resulting data closely matches the data in the original rrd
+file.
+
+If the DS configuration of the new RRD file differs from the original
+one the B<--src-tmp> and B<--dest-tmp> options can be used to override
+the default order of DS entries.
+
+=head1 BEWARE
+
+There are two warnings you should keep in mind:
+
+=over
+
+=item *
+
+This is NEW CODE, so there may be hidden problem. This this first on your real data before doing any major conversions.
+
+=item *
+
+In my testing there were differences between source and destination which I attribute to
+quantization issues especially when switching from one consolidation level to the next one.
+
+=back
+
+=head1 EXAMPLE
+
+F<legacy.rrd> has data for the last two years and F<new.rrd> is still empty
+but created with a start data two years in the past. F<legacy.rrd> contains
+4 Date Sources (in,out,error,drop) and F<new.rrd> contains 3 datasources
+(myout,myin,overrun). We want to transfer the old 'in' to 'myin' and 'out'
+to 'myout' while dropping 'error' and 'drop'.
+
+ rrdjiig --src-tmpl=in:out --dst-tmpl=myin:myout legacy.rrd new.rrd
+
+=head1 COPYRIGHT
+
+Copyright (c) 2010 by OETIKER+PARTNER AG. All rights reserved.
+
+=head1 LICENSE
+
+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 3 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.
+
+=head1 AUTHOR
+
+S<Tobi Oetiker E<lt>tobi@oetiker.chE<gt>>
+
+=head1 HISTORY
+
+ 2010-02-25 to Initial Version
+
+=cut
+
+# Emacs Configuration
+#
+# Local Variables:
+# mode: cperl
+# eval: (cperl-set-style "PerlStyle")
+# mode: flyspell
+# mode: flyspell-prog
+# End:
+#
+# vi: sw=4 et

diff --git a/contrib/rrdjig/test-data.pl b/contrib/rrdjig/test-data.pl
new file mode 100755 (executable)
index 0000000..926b175
--- /dev/null
+++ b/contrib/rrdjig/test-data.pl
@@ -0,0 +1,49 @@
+#!/usr/bin/perl -w
+require 5.008;
+use lib qw(/scratch/rrd-1.4.3-test2/lib/perl);  
+use RRDs;
+my $start = time - 6*15*60;
+$start -= $start % 60;
+RRDs::create(qw(
+    --step=60
+    src.rrd    
+    DS:in:COUNTER:65:0:1000
+    DS:out:COUNTER:65:0:1000
+    DS:xyz:GAUGE:65:0:1000
+    RRA:AVERAGE:0.5:1:10
+    RRA:MIN:0.5:1:10
+    RRA:MAX:0.5:2:10
+    RRA:AVERAGE:0.5:3:10
+    RRA:MIN:0.99:4:20
+    RRA:MAX:0.5:3:10
+    RRA:AVERAGE:0.5:5:10
+    RRA:MIN:0.99:6:15
+    RRA:MAX:0.5:4:15
+),'--start',$start);
+die RRDs::error if RRDs::error;
+RRDs::create(qw(
+    --step=60
+    dst.rrd    
+    DS:newin:COUNTER:65:0:1000
+    DS:newout:COUNTER:65:0:1000
+    RRA:AVERAGE:0.5:1:10
+    RRA:MIN:0.5:1:10
+    RRA:MAX:0.5:2:10
+    RRA:AVERAGE:0.5:3:10
+    RRA:MIN:0.99:4:20
+    RRA:MAX:0.5:3:10
+    RRA:AVERAGE:0.5:5:10
+    RRA:MIN:0.99:6:15
+    RRA:MAX:0.5:4:15
+),'--start',$start);
+die RRDs::error if RRDs::error;
+my $a = 0;
+for (my $i=$start;$i<=time;$i+=60){
+    $a++;
+    my $up = "$i:".($a*$a).":".$a.":".$a;
+    RRDs::update('src.rrd',$up);
+}
+die RRDs::error if RRDs::error;
+
+
+