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