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 sub rrd_warn_check(){
  40     my $err = RRDs::error();
  41     if ($err){
  42         warn "RRD Warning: $err\n";
  43     }
  44 }
  45
  46 # how should the data be fetched from the source
  47 # to provide the best approximation of the original data
  48
  49 sub step_sync ($$){
  50     my $value = shift;
  51     my $step = shift;
  52     return ($value - ($value % $step));
  53 }
  54
  55 sub get_rra_size_map($){
  56     my $info = shift;
  57     my $map = {};
  58     my $min_start;
  59     for (my $i=0;;$i++){
  60         my $cf = $info->{"rra[$i].cf"};
  61         last if not $cf;
  62         next if $cf !~ /AVERAGE|MIN|MAX/;
  63         my $pdp_per_row = $info->{"rra[$i].pdp_per_row"};
  64         next if $cf =~ /MIN|MAX/ and $pdp_per_row == 1;
  65         my $rows = $info->{"rra[$i].rows"};
  66         my $step = $pdp_per_row*$info->{step};
  67         my $start = step_sync($info->{last_update},$step) - $step*$rows;
  68         if (not defined $min_start or $start < $min_start) {
  69             $min_start = $start;
  70         }
  71         if (  $map->{$cf}{$pdp_per_row}{rows} || 0 < $rows
  72             or $map->{$cf}{$pdp_per_row}{start} || 0 < $start ){
  73             $map->{$cf}{$pdp_per_row} = {
  74                 id   => $i,
  75                 rows => $rows,
  76                 step => $step,
  77                 start => $start
  78             };
  79         }
  80     }
  81     return ($min_start,$map);
  82 }
  83
  84
  85 sub prep_fetch_tasks ($$){
  86     my $src_info = shift;
  87     my $dst_info = shift;
  88     my ($min_start,$src_size) = get_rra_size_map($src_info);
  89     my $now = step_sync($src_info->{last_update}, $src_info->{step});
  90     my $first = step_sync($dst_info->{last_update} , $dst_info->{step});
  91     if ($min_start > $first ) {
  92         $first = $min_start;
  93     }
  94     print "Search $first to $now\n" if $opt{verbose};
  95     my $task = {};
  96     for my $cf (qw(AVERAGE MIN MAX)){
  97         my $x = $src_size->{$cf};
  98         my $pointer = $now;
  99         $task->{$cf} = [];
 100         for my $pdp_per_row (sort {$a <=> $b} keys %$x){
 101             my $step = $x->{$pdp_per_row}{step};
 102             my $new_pointer = $x->{$pdp_per_row}{start};
 103             print "look $cf $pdp_per_row * $step - $new_pointer\n" if $opt{verbose};
 104             if ($new_pointer <= $first){
 105                 $new_pointer = step_sync($first,$step);
 106             }
 107             if ($new_pointer <= $pointer){
 108                 unshift @{$task->{$cf}}, {
 109                     start => $new_pointer,
 110                     end => step_sync($pointer,$step),
 111                     step => $step
 112                 };
 113                 $pointer = $new_pointer;
 114             }
 115             last if $pointer <= $first;
 116         }
 117     }
 118     return ($first,$task);
 119 }
 120
 121 sub fetch_data($$$){
 122     my $src = shift;
 123     my $first = shift;
 124     my $tasks = shift;
 125     my %data;
 126     my @tmpl;
 127     if ($opt{'src-tmpl'}){
 128         @tmpl = split /:/, $opt{'src-tmpl'};
 129     }
 130     my %map;
 131     for my $cf (keys %$tasks){
 132         print STDERR "FETCH #### CF $cf #####################################\n"
 133             if $opt{verbose};
 134         for my $t (@{$tasks->{$cf}}){
 135             my ($start,$step,$names,$array) = RRDs::fetch(
 136                 $src,$cf,'--resolution',$t->{step},
 137                 '--start',$t->{start},'--end',$t->{end}
 138             );
 139             my $id = 0;
 140             if (@tmpl and not %map){
 141                 %map = ( map { ($_,$id++) } @$names );
 142                 for my $key (@tmpl){
 143                     die "ERROR: src key '$key' is not known in $src. Pick from ".join(':',@$names)."\n"
 144                         if not exists $map{$key};
 145                 }
 146             }
 147             rrd_err_check();
 148             print STDERR "FETCH: want setp $t->{step} -> got step $step  / want start $t->{start} -> got start $start\n" if $opt{verbose};
 149             my $now = $start;
 150             while (my $row = shift @$array){
 151                 if (@tmpl){
 152                     push @{$data{$cf}} , [ $now, $step, [ @$row[@map{@tmpl}] ] ];
 153                 }
 154                 else {
 155                     push @{$data{$cf}} , [ $now, $step, $row ];
 156                 }
 157                 $now+=$step;
 158             }
 159         }
 160     }
 161     die "ERROR: no AVERAGE RRA found in src rrd. Enhance me to be able to deal with this!\n"
 162         if not $data{AVERAGE};
 163     # if older data is required, generate a fake average entry.
 164     my $start = $data{AVERAGE}[0][0] - $data{AVERAGE}[0][1];
 165     if ($start > $first ) {
 166         my $step = $start - $first;
 167         unshift @{$data{AVERAGE}}, [ $start, $step, [ map {undef} @{$data{AVERAGE}[0][2]} ] ];
 168     }
 169     return (\%data);
 170 }
 171
 172 sub reupdate($$$$){
 173     my $step = shift;
 174     my $min_time = shift;
 175     my $dst = shift;
 176     my $data = shift;
 177     my @min;
 178     my @max;
 179     my @pending = map { 0 } @{$data->{AVERAGE}[0][2]};
 180     my $hide_cnt = 0;
 181     my @up;
 182     while (my $av = shift @{$data->{AVERAGE}}){
 183         my $end = $av->[0];
 184         my $start = $end - $av->[1];
 185         if (my $av_nx = $data->{AVERAGE}[0]){
 186             my $start_nx = $av_nx->[0] - $av_nx->[1];
 187             if ($end > $start_nx){
 188                 $end = $start_nx;
 189             }
 190         }
 191         STEP:
 192         for (my $t = $start+$step;$t<=$end;$t+=$step){
 193             my @out = @{$av->[2]};
 194             # lets see if we a usable a MIN or MAX entry pending
 195             if ($hide_cnt <= 2 and $av->[1] > $step) {
 196                 for my $cf (qw(MIN MAX)){
 197                     my $m = $data->{$cf}[0];
 198                     # drop any MIN/MAX entries which we could not use
 199                     while ($m->[0] <= $start) {
 200                         print STDERR "# DROP $cf $m->[0], $m->[1]\n" if $opt{verbose};
 201                         shift @{$data->{$cf}};
 202                         $m = $data->{$cf}[0];
 203                     }
 204                     my $cend = $m->[0];
 205                     my $cstep = $m->[1];
 206                     my $crow = $m->[2];
 207                     if ($cend >= $t and $cend - $cstep <= $t - $step){
 208                         my $row = "$t:".join(':',map {defined $_ ? $_ : 'U'} @{$crow});
 209                         if ($cf eq 'MIN'){
 210                             @min = @{$crow};
 211                         } else {
 212                             @max = @{$crow};
 213                         }
 214                         print STDERR ($cf eq 'MIN' ? 'm' : 'M' ) ,$row,"\n" if $opt{verbose};
 215                         push @up, $row;
 216                         $hide_cnt++;
 217                         for (my $i = 0; $i <@$crow; $i++){
 218                             if (defined $pending[$i]){
 219                                 if (defined $crow->[$i] and defined $out[$i]){
 220                                     my $keep = ($out[$i] - $crow->[$i]);
 221 #                                   print STDERR " - keep $keep\n" if $opt{verbose};
 222                                     $pending[$i] += $keep;
 223                                 }
 224                                 else {
 225                                     $pending[$i] = undef;
 226                                 }
 227                             }
 228                         }
 229                         shift @{$data->{$cf}};
 230                         next STEP;
 231                     }
 232                 }
 233             }
 234
 235             # compensate for data not shown while insering fake MIN/MAX entries
 236             for (my $i = 0; $i < @out; $i++){
 237                 if (defined $out[$i] and defined $pending[$i] and $pending[$i] != 0){
 238                     my $new = $out[$i] + $pending[$i];
 239                     if (defined $max[$i] and $new > $max[$i]) {
 240                         $pending[$i] = $new - $max[$i];
 241                         $out[$i] = $max[$i];
 242 #                       print STDERR " - maxout $i $out[$i]\n" if $opt{verbose};
 243                     }
 244                     elsif (defined $min[$i] and $new < $min[$i]){
 245                         $pending[$i] = $new - $min[$i];
 246                         $out[$i] = $min[$i];
 247 #                       print STDERR " - minout $i $out[$i]\n" if $opt{verbose};
 248                     }
 249                     else {
 250                         $pending[$i] = 0;
 251                         $out[$i] = $new;
 252 #                       print STDERR " - combined $i $out[$i]\n" if $opt{verbose};
 253                     }
 254                 }
 255                 else {
 256                     $pending[$i] = 0;
 257                 }
 258             }
 259             $hide_cnt = 0;
 260             # show the result;
 261             my $row = "$t:".join(':',map {defined $_ ? $_ : 'U'} @out);
 262             print STDERR " ",$row,"\n" if $opt{verbose};
 263             push @up, $row if $t > $min_time;
 264         }
 265     }
 266     pop @up; # the last update is most likely one too many ...
 267     if (@up == 0) {
 268         warn "WARNING: src has no entries new enough to fill dst\n";
 269     } else {
 270         print STDERR ".";
 271         RRDs::update($dst,
 272                      $opt{'dst-tmpl'} ? '--template='.$opt{'dst-tmpl'} : (),
 273                      @up);
 274         rrd_warn_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 = fetch_data($src,$first,$fetch_tasks);
 323     set_gauge($dst,$dst_info);
 324     reupdate($src_info->{step},$dst_info->{last_update},$dst,$updates);
 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