contrib/rrdjig/rrdjig.pl

   1 #!/usr/bin/perl -w
   2 require 5.008;
   3 use lib qw(/scratch/rrd-1.4.3-test2/lib/perl);
   4 use RRDs;
   5 use strict;
   6 use Getopt::Long 2.25 qw(:config posix_default no_ignore_case);
   7 use Pod::Usage 1.14;
   8 use Data::Dumper;
   9
  10 '$Revision$ ' =~ /Revision: (\S*)/;
  11 my $Revision = $1;
  12
  13 # main loop
  14 my %opt = ();
  15 sub main()
  16 {
  17     # parse options
  18     GetOptions(\%opt, 'help|h', 'man', 'version', 'noaction|no-action|n',
  19         'verbose|v','src-tmpl=s','dst-tmpl=s') or exit(1);
  20     if($opt{help})     { pod2usage(1) }
  21     if($opt{man})      { pod2usage(-exitstatus => 0, -verbose => 2) }
  22     if($opt{version})  { print "rrdjig $Revision\n"; exit(0) }
  23     my $src = shift @ARGV or pod2usage(1);
  24     if (not -r $src)   { pod2usage("Reading $src: $!") }
  25     my $dst = shift @ARGV or pod2usage(1);
  26     if (not -w $dst)   { pod2usage("Accessing $dst: $!") }
  27
  28     rrdjig($src,$opt{'src-tmpl'},$dst,$opt{'dst-tmpl'});
  29 }
  30
  31 main;
  32
  33 sub rrd_err_check(){
  34     my $err = RRDs::error();
  35     if ($err){
  36         die "RRD Error: $err\n";
  37     }
  38 }
  39
  40 # how should the data be fetched from the source
  41 # to provide the best approximation of the original data
  42
  43 sub step_sync ($$){
  44     my $value = shift;
  45     my $step = shift;
  46     return ($value - ($value % $step));
  47 }
  48
  49 sub get_rra_size_map($){
  50     my $info = shift;
  51     my $map = {};
  52     my $min_start;
  53     for (my $i=0;;$i++){
  54         my $cf = $info->{"rra[$i].cf"};
  55         last if not $cf;
  56         next if $cf !~ /AVERAGE|MIN|MAX/;
  57         my $pdp_per_row = $info->{"rra[$i].pdp_per_row"};
  58         next if $cf =~ /MIN|MAX/ and $pdp_per_row == 1;
  59         my $rows = $info->{"rra[$i].rows"};
  60         my $step = $pdp_per_row*$info->{step};
  61         my $start = step_sync($info->{last_update},$step) - $step*$rows;
  62         if (not defined $min_start or $start < $min_start) {
  63             $min_start = $start;
  64         }
  65         if (  $map->{$cf}{$pdp_per_row}{rows} || 0 < $rows
  66             or $map->{$cf}{$pdp_per_row}{start} || 0 < $start ){
  67             $map->{$cf}{$pdp_per_row} = {
  68                 id   => $i,
  69                 rows => $rows,
  70                 step => $step,
  71                 start => $start
  72             };
  73         }
  74     }
  75     return ($min_start,$map);
  76 }
  77
  78
  79 sub prep_fetch_tasks ($$){
  80     my $src_info = shift;
  81     my $dst_info = shift;
  82     my ($min_start,$src_size) = get_rra_size_map($src_info);
  83     my $now = step_sync($src_info->{last_update}, $src_info->{step});
  84     my $first = step_sync($dst_info->{last_update} , $dst_info->{step});
  85     if ($min_start > $first ) {
  86         $first = $min_start;
  87     }
  88     print "Search $first to $now\n" if $opt{verbose};
  89     my $task = {};
  90     for my $cf (qw(AVERAGE MIN MAX)){
  91         my $x = $src_size->{$cf};
  92         my $pointer = $now;
  93         $task->{$cf} = [];
  94         for my $pdp_per_row (sort {$a <=> $b} keys %$x){
  95             my $step = $x->{$pdp_per_row}{step};
  96             my $new_pointer = $x->{$pdp_per_row}{start};
  97             print "look $cf $pdp_per_row * $step - $new_pointer\n" if $opt{verbose};
  98             if ($new_pointer <= $first){
  99                 $new_pointer = step_sync($first,$step);
 100             }
 101             if ($new_pointer <= $pointer){
 102                 unshift @{$task->{$cf}}, {
 103                     start => $new_pointer,
 104                     end => step_sync($pointer,$step),
 105                     step => $step
 106                 };
 107                 $pointer = $new_pointer;
 108             }
 109             last if $pointer <= $first;
 110         }
 111     }
 112     return ($first,$task);
 113 }
 114
 115 sub fetch_data($$$){
 116     my $src = shift;
 117     my $first = shift;
 118     my $tasks = shift;
 119     my %data;
 120     my @tmpl;
 121     if ($opt{'src-tmpl'}){
 122         @tmpl = split /:/, $opt{'src-tmpl'};
 123     }
 124     my %map;
 125     my @min;
 126     my @max;
 127     for my $cf (keys %$tasks){
 128         print STDERR "FETCH #### CF $cf #####################################\n"
 129             if $opt{verbose};
 130         for my $t (@{$tasks->{$cf}}){
 131             my ($start,$step,$names,$array) = RRDs::fetch(
 132                 $src,$cf,'--resolution',$t->{step},
 133                 '--start',$t->{start},'--end',$t->{end}
 134             );
 135             my $id = 0;
 136             if (@tmpl and not %map){
 137                 %map = ( map { ($_,$id++) } @$names );
 138                 for my $key (@tmpl){
 139                     die "ERROR: src key '$key' is not known in $src. Pick from ".join(':',@$names)."\n"
 140                         if not exists $map{$key};
 141                 }
 142             }
 143             rrd_err_check();
 144             print STDERR "FETCH: want setp $t->{step} -> got step $step  / want start $t->{start} -> got start $start\n" if $opt{verbose};
 145             my $now = $start;
 146             while (my $row = shift @$array){
 147                 for (my $i = 0;$i < scalar @$array;$i++){
 148                     if (defined $row->[$i]){
 149                         $min[$i] = $row->[$i] if not defined $min[$i] or $row->[$i] < $min[$i];
 150                         $max[$i] = $row->[$i] if not defined $max[$i] or $row->[$i] > $max[$i];
 151                     }
 152                 }
 153                 if (@tmpl){
 154                     push @{$data{$cf}} , [ $now, $step, [ @$row[@map{@tmpl}] ] ];
 155                 }
 156                 else {
 157                     push @{$data{$cf}} , [ $now, $step, $row ];
 158                 }
 159                 $now+=$step;
 160             }
 161         }
 162     }
 163     die "ERROR: no AVERAGE RRA found in src rrd. Enhance me to be able to deal with this!\n"
 164         if not $data{AVERAGE};
 165     # if older data is required, generate a fake average entry.
 166     my $start = $data{AVERAGE}[0][0] - $data{AVERAGE}[0][1];
 167     if ($start > $first ) {
 168         my $step = $start - $first;
 169         unshift @{$data{AVERAGE}}, [ $start, $step, [ map {undef} @{$data{AVERAGE}[0][2]} ] ];
 170     }
 171     if (@tmpl){
 172         return (\%data,[@min[@map{@tmpl}]],[@max[@map{@tmpl}]]);
 173     }
 174     else {
 175         return (\%data,\@min,\@max);
 176     }
 177 }
 178
 179 sub reupdate($$$$$){
 180     my $step = shift;
 181     my $dst = shift;
 182     my $data = shift;
 183     my $min = shift;
 184     my $max = shift;
 185     my @pending = map { 0 } @{$data->{AVERAGE}[0][2]};
 186     my $hide_cnt = 0;
 187     my @up;
 188     while (my $av = shift @{$data->{AVERAGE}}){
 189         my $end = $av->[0];
 190         my $start = $end - $av->[1];
 191         if (my $av_nx = $data->{AVERAGE}[0]){
 192             my $start_nx = $av_nx->[0] - $av_nx->[1];
 193             if ($end > $start_nx){
 194                 $end = $start_nx;
 195             }
 196         }
 197         STEP:
 198         for (my $t = $start+$step;$t<=$end;$t+=$step){
 199             my @out = @{$av->[2]};
 200             # lets see if we a usable a MIN or MAX entry pending
 201             if ($hide_cnt <= 2 and $av->[1] > $step) {
 202                 for my $cf (qw(MIN MAX)){
 203                     my $m = $data->{$cf}[0];
 204                     # drop any MIN/MAX entries which we could not use
 205                     while ($m->[0] <= $start) {
 206                         print STDERR "# DROP $cf $m->[0], $m->[1]\n" if $opt{verbose};
 207                         shift @{$data->{$cf}};
 208                         $m = $data->{$cf}[0];
 209                     }
 210                     my $cend = $m->[0];
 211                     my $cstep = $m->[1];
 212                     my $crow = $m->[2];
 213                     if ($cend >= $t and $cend - $cstep <= $t - $step){
 214                         my $row = "$t:".join(':',map {defined $_ ? $_ : 'U'} @{$crow});
 215                         print STDERR ($cf eq 'MIN' ? 'm' : 'M' ) ,$row,"\n" if $opt{verbose};
 216                         push @up, $row;
 217                         $hide_cnt++;
 218                         for (my $i = 0; $i <@$crow; $i++){
 219                             if (defined $pending[$i]){
 220                                 if (defined $crow->[$i] and defined $out[$i]){
 221                                     my $keep = ($out[$i] - $crow->[$i]);
 222 #                                   print STDERR " - keep $keep\n" if $opt{verbose};
 223                                     $pending[$i] += $keep;
 224                                 }
 225                                 else {
 226                                     $pending[$i] = undef;
 227                                 }
 228                             }
 229                         }
 230                         shift @{$data->{$cf}};
 231                         next STEP;
 232                     }
 233                 }
 234             }
 235
 236             # compensate for data not shown while insering fake MIN/MAX entries
 237             for (my $i = 0; $i < @out; $i++){
 238                 if (defined $out[$i] and defined $pending[$i] and $pending[$i] != 0){
 239                     my $new = $out[$i] + $pending[$i];
 240                     if (defined $max->[$i] and $new > $max->[$i]) {
 241                         $pending[$i] = $new - $max->[$i];
 242                         $out[$i] = $max->[$i];
 243 #                       print STDERR " - maxout $i $out[$i]\n" if $opt{verbose};
 244                     }
 245                     elsif (defined $min->[$i] and $new < $min->[$i]){
 246                         $pending[$i] = $new - $min->[$i];
 247                         $out[$i] = $min->[$i];
 248 #                       print STDERR " - minout $i $out[$i]\n" if $opt{verbose};
 249                     }
 250                     else {
 251                         $pending[$i] = 0;
 252                         $out[$i] = $new;
 253 #                       print STDERR " - combined $i $out[$i]\n" if $opt{verbose};
 254                     }
 255                 }
 256                 else {
 257                     $pending[$i] = 0;
 258                 }
 259             }
 260             $hide_cnt = 0;
 261             # show the result;
 262             my $row = "$t:".join(':',map {defined $_ ? $_ : 'U'} @out);
 263             print STDERR " ",$row,"\n" if $opt{verbose};
 264             push @up, $row;
 265         }
 266     }
 267     pop @up; # the last update is most likely one too many ...
 268     if (@up == 0) {
 269         warn "WARNING: src has no entries new enough to fill dst\n";
 270     } else {
 271         RRDs::update($dst,
 272                      $opt{'dst-tmpl'} ? '--template='.$opt{'dst-tmpl'} : (),
 273                      @up);
 274         rrd_err_check();
 275     }
 276 }
 277
 278 sub set_gauge($$){
 279     my $dst = shift;
 280     my $info = shift;
 281     my @tasks;
 282     for my $key (keys %$info) {
 283         if ($key =~ m/^ds\[(.+)\]\.type$/
 284             and $info->{$key} ne 'GAUGE'){
 285             print STDERR "DS $1 -> GAUGE\n" if $opt{verbose};
 286             push @tasks, "--data-source-type=${1}:GAUGE";
 287         }
 288         if (@tasks) {
 289             RRDs::tune($dst,@tasks);
 290             rrd_err_check();
 291         }
 292     }
 293 }
 294
 295 sub unset_gauge($$){
 296     my $dst = shift;
 297     my $info = shift;
 298     my @tasks;
 299     for my $key (keys %$info) {
 300         if ($key =~ m/^ds\[(.+)\]\.type$/
 301             and $info->{$key} ne 'GAUGE'){
 302             print STDERR "DS $1 -> $info->{$key}\n" if $opt{verbose};
 303             push @tasks, "--data-source-type=${1}:$info->{$key}";
 304         }
 305         if (@tasks) {
 306             RRDs::tune($dst,@tasks);
 307             rrd_err_check();
 308         }
 309     }
 310 }
 311
 312 sub rrdjig($$$$){
 313     my $src = shift;
 314     my $src_tmpl = shift;
 315     my $dst = shift;
 316     my $dst_tmpl = shift;
 317     my $dst_info = RRDs::info($dst);
 318     rrd_err_check();
 319     my $src_info = RRDs::info($src);
 320     rrd_err_check();
 321     my ($first,$fetch_tasks) = prep_fetch_tasks($src_info,$dst_info);
 322     my ($updates,$min,$max) = fetch_data($src,$first,$fetch_tasks);
 323     set_gauge($dst,$dst_info);
 324     reupdate($src_info->{step},$dst,$updates,$min,$max);
 325     unset_gauge($dst,$dst_info);
 326 }
 327
 328
 329 __END__
 330
 331 =head1 NAME
 332
 333 rrdjig - use data from an existing rrd file to populate a new one
 334
 335 =head1 SYNOPSIS
 336
 337 B<rrdjig> [I<options>...] I<src.rrd> I<dest.rrd>
 338
 339      --man           show man-page and exit
 340  -h, --help          display this help and exit
 341      --version       show version information and exit
 342      --verbose       talk while you work
 343      --noaction      just talk don't act
 344      --src-tmpl=tmpl output template for the source rrd
 345      --dst-tmpl=tmpl input template for the destination rrd
 346
 347 =head1 DESCRIPTION
 348
 349 In rrdtool, data gets processed immediately upon arrival. This means that
 350 the original data is never stored and it is thus not easily possible to
 351 restructure data at a later stage. In the rrdtool core there are no
 352 functions to modify the base step size nor the number and types of RRAs in a
 353 graceful manner.
 354
 355 The rrdjig tool tries to rebuild the original data as closely as possible
 356 based on the data found in the rrd file. It takes AVERAGE, MIN and MAX RRAs
 357 into account and rebuilds the original data stream such that it can be
 358 re-entered into a fresh rrd file. Depending on the configuration of the new
 359 rrd file the resulting data closely matches the data in the original rrd
 360 file.
 361
 362 If the DS configuration of the new RRD file differs from the original
 363 one the B<--src-tmp> and B<--dest-tmp> options can be used to override
 364 the default order of DS entries.
 365
 366 =head1 BEWARE
 367
 368 There are two warnings you should keep in mind:
 369
 370 =over
 371
 372 =item *
 373
 374 This is NEW CODE, so there may be hidden problem. This this first on your real data before doing any major conversions.
 375
 376 =item *
 377
 378 In my testing there were differences between source and destination which I attribute to
 379 quantization issues especially when switching from one consolidation level to the next one.
 380
 381 =back
 382
 383 =head1 EXAMPLE
 384
 385 F<legacy.rrd> has data for the last two years and F<new.rrd> is still empty
 386 but created with a start data two years in the past. F<legacy.rrd> contains
 387 4 Date Sources (in,out,error,drop) and F<new.rrd> contains 3 data-sources
 388 (myout,myin,overrun). We want to transfer the old 'in' to 'myin' and 'out'
 389 to 'myout' while dropping 'error' and 'drop'.
 390
 391  rrdjiig --src-tmpl=in:out --dst-tmpl=myin:myout legacy.rrd new.rrd
 392
 393 =head1 COPYRIGHT
 394
 395 Copyright (c) 2010 by OETIKER+PARTNER AG. All rights reserved.
 396
 397 =head1 LICENSE
 398
 399 This program is free software; you can redistribute it and/or modify
 400 it under the terms of the GNU General Public License as published by
 401 the Free Software Foundation; either version 3 of the License, or
 402 (at your option) any later version.
 403
 404 This program is distributed in the hope that it will be useful,
 405 but WITHOUT ANY WARRANTY; without even the implied warranty of
 406 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 407 GNU General Public License for more details.
 408
 409 You should have received a copy of the GNU General Public License
 410 along with this program; if not, write to the Free Software
 411 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 412
 413 =head1 AUTHOR
 414
 415 S<Tobi Oetiker E<lt>tobi@oetiker.chE<gt>>
 416
 417 The development of  this tool has been sponsored by L<www.init7.net|http://www.init7.net>.
 418
 419 =head1 HISTORY
 420
 421  2010-02-25 to Initial Version
 422
 423 =cut
 424
 425 # Emacs Configuration
 426 #
 427 # Local Variables:
 428 # mode: cperl
 429 # eval: (cperl-set-style "PerlStyle")
 430 # mode: flyspell
 431 # mode: flyspell-prog
 432 # End:
 433 #
 434 # vi: sw=4 et