Code

a212de5a4ae5945274b0cf38c601fa25b40b897f
[collectd.git] / contrib / rrd_filter.px
1 #!/usr/bin/perl
3 # collectd - contrib/rrd_filter.px
4 # Copyright (C) 2007-2008  Florian octo Forster
5 #
6 # This program is free software; you can redistribute it and/or modify it
7 # under the terms of the GNU General Public License as published by the
8 # Free Software Foundation; only version 2 of the License is applicable.
9 #
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13 # General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License along
16 # with this program; if not, write to the Free Software Foundation, Inc.,
17 # 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
18 #
19 # Authors:
20 #   Florian octo Forster <octo at verplant.org>
22 use strict;
23 use warnings;
25 =head1 NAME
27 rrd_filter.px - Perform same advanced non-standard operations on an RRD file.
29 =head1 SYNOPSYS
31   rrd_filter.px -i input.rrd -o output.rrd [options]
33 =head1 DEPENDENCIES
35 rrd_filter.px requires the RRDTool binary, Perl and the included
36 L<Getopt::Long> module.
38 =cut
40 use Getopt::Long ('GetOptions');
42 our $InFile;
43 our $InDS = [];
44 our $OutFile;
45 our $OutDS = [];
47 our $NewRRAs = [];
49 our $Step = 0;
51 =head1 OPTIONS
53 The following options can be passed on the command line:
55 =over 4
57 =item B<--infile> I<file>
59 =item B<-i> I<file>
61 Reads from I<file>. If I<file> ends in C<.rrd>, then C<rrdtool dump> is invoked
62 to create an XML dump of the RRD file. Otherwise the XML dump is expected
63 directly. The special filename C<-> can be used to read from STDIN.
65 =item B<--outfile> I<file>
67 =item B<-o> I<file>
69 Writes output to I<file>. If I<file> ends in C<.rrd>, then C<rrdtool restore>
70 is invoked to create a binary RRD file. Otherwise an XML output is written. The
71 special filename C<-> can be used to write to STDOUT.
73 =item B<--map> I<in_ds>:I<out_ds>
75 =item B<-m> I<in_ds>:I<out_ds>
77 Writes the datasource I<in_ds> to the output and renames it to I<out_ds>. This
78 is useful to extract one DS from an RRD file.
80 =item B<--step> I<seconds>
82 =item B<-s> I<seconds>
84 Changes the step of the output RRD file to be I<seconds>. The new stepsize must
85 be a multiple of the old stepsize of the other way around. When increasing the
86 stepsize the number of PDPs in each RRA must be dividable by the factor by
87 which the stepsize is increased. The length of CDPs and the absolute length of
88 RRAs (and thus the data itself) is not altered.
90 Examples:
92   step =  10, rra_steps = 12   =>   step = 60, rra_steps =  2
93   step = 300, rra_steps =  1   =>   step = 10, rra_steps = 30
95 =item B<--rra> B<RRA>:I<CF>:I<XFF>:I<steps>:I<rows>
97 =item B<-a> B<RRA>:I<CF>:I<XFF>:I<steps>:I<rows>
99 Inserts a new RRA in the generated RRD file. This is done B<after> the step has
100 been adjusted, take that into account when specifying I<steps> and I<rows>. For
101 an explanation of the format please see L<rrdcreate(1)>.
103 =back
105 =cut
107 GetOptions ("infile|i=s" => \$InFile,
108         "outfile|o=s" => \$OutFile,
109         'map|m=s' => sub
110         {
111                 my ($in_ds, $out_ds) = split (':', $_[1]);
112                 if (!defined ($in_ds) || !defined ($out_ds))
113                 {
114                         print STDERR "Argument for `map' incorrect! The format is `--map in_ds:out_ds'\n";
115                         exit (1);
116                 }
117                 push (@$InDS, $in_ds);
118                 push (@$OutDS, $out_ds);
119         },
120         'step|s=i' => \$Step,
121         'rra|a=s' => sub
122         {
123                 my ($rra, $cf, $xff, $steps, $rows) = split (':', $_[1]);
124                 if (($rra ne 'RRA') || !defined ($rows))
125                 {
126                         print STDERR "Please use the standard RRDTool syntax when adding RRAs. I. e. RRA:<cf><xff>:<steps>:<rows>.\n";
127                         exit (1);
128                 }
129                 push (@$NewRRAs, {cf => $cf, xff => $xff, steps => $steps, rows => $rows});
130         }
131 ) or exit (1);
133 if (!$InFile || !$OutFile)
135         print STDERR "Usage: $0 -i <infile> -m <in_ds>:<out_ds> -s <step>\n";
136         exit (1);
138 if ((1 + @$InDS) != (1 + @$OutDS))
140         print STDERR "You need the same amount of in- and out-DSes\n";
141         exit (1);
144 main ($InFile, $OutFile);
145 exit (0);
148 my $ds_index;
149 my $current_index;
150 # state 0 == searching for DS index
151 # state 1 == parse RRA header
152 # state 2 == parse values
153 my $state;
154 my $out_cache;
155 sub handle_line_dsmap
157         my $line = shift;
158         my $index = shift;
159         my $ret = '';
161         if ((@$InDS == 0) || (@$OutDS == 0))
162         {
163                 post_line ($line, $index + 1);
164                 return;
165         }
167         if (!defined ($state))
168         {
169                 $current_index = -1;
170                 $state = 0;
171                 $out_cache = [];
173                 # $ds_index->[new_index] = old_index
174                 $ds_index = [];
175                 for (my $i = 0; $i < @$InDS; $i++)
176                 {
177                         $ds_index->[$i] = -1;
178                 }
179         }
181         if ($state == 0)
182         {
183                 if ($line =~ m/<ds>/)
184                 {
185                         $current_index++;
186                         $out_cache->[$current_index] = $line;
187                 }
188                 elsif ($line =~ m#<name>\s*([^<\s]+)\s*</name>#)
189                 {
190                         # old_index == $current_index
191                         # new_index == $i
192                         for (my $i = 0; $i < @$InDS; $i++)
193                         {
194                                 next if ($ds_index->[$i] >= 0);
196                                 if ($1 eq $InDS->[$i])
197                                 {
198                                         $line =~ s#<name>\s*([^<\s]+)\s*</name>#<name> $OutDS->[$i] </name>#;
199                                         $ds_index->[$i] = $current_index;
200                                         last;
201                                 }
202                         }
204                         $out_cache->[$current_index] .= $line;
205                 }
206                 elsif ($line =~ m#</ds>#)
207                 {
208                         $out_cache->[$current_index] .= $line;
209                 }
210                 elsif ($line =~ m#<rra>#)
211                 {
212                         # Print out all the DS definitions we need
213                         for (my $new_index = 0; $new_index < @$InDS; $new_index++)
214                         {
215                                 my $old_index = $ds_index->[$new_index];
216                                 while ($out_cache->[$old_index] =~ m/^(.*)$/gm)
217                                 {
218                                         post_line ("$1\n", $index + 1);
219                                 }
220                         }
222                         # Clear the cache - it's used in state1, too.
223                         for (my $i = 0; $i <= $current_index; $i++)
224                         {
225                                 $out_cache->[$i] = '';
226                         }
228                         $ret .= $line;
229                         $current_index = -1;
230                         $state = 1;
231                 }
232                 elsif ($current_index == -1)
233                 {
234                         # Print all the lines before the first DS definition
235                         $ret .= $line;
236                 }
237                 else
238                 {
239                         # Something belonging to a DS-definition
240                         $out_cache->[$current_index] .= $line;
241                 }
242         }
243         elsif ($state == 1)
244         {
245                 if ($line =~ m#<ds>#)
246                 {
247                         $current_index++;
248                         $out_cache->[$current_index] .= $line;
249                 }
250                 elsif ($line =~ m#</cdp_prep>#)
251                 {
252                         # Print out all the DS definitions we need
253                         for (my $new_index = 0; $new_index < @$InDS; $new_index++)
254                         {
255                                 my $old_index = $ds_index->[$new_index];
256                                 while ($out_cache->[$old_index] =~ m/^(.*)$/gm)
257                                 {
258                                         post_line ("$1\n", $index + 1);
259                                 }
260                         }
262                         # Clear the cache
263                         for (my $i = 0; $i <= $current_index; $i++)
264                         {
265                                 $out_cache->[$i] = '';
266                         }
268                         $ret .= $line;
269                         $current_index = -1;
270                 }
271                 elsif ($line =~ m#<database>#)
272                 {
273                         $ret .= $line;
274                         $state = 2;
275                 }
276                 elsif ($current_index == -1)
277                 {
278                         # Print all the lines before the first DS definition
279                         # and after cdp_prep
280                         $ret .= $line;
281                 }
282                 else
283                 {
284                         # Something belonging to a DS-definition
285                         $out_cache->[$current_index] .= $line;
286                 }
287         }
288         elsif ($state == 2)
289         {
290                 if ($line =~ m#</database>#)
291                 {
292                         $ret .= $line;
293                         $current_index = -1;
294                         $state = 1;
295                 }
296                 else
297                 {
298                         my @values = ();
299                         my $i;
300                         
301                         $ret .= "\t\t";
303                         if ($line =~ m#(<!-- .*? -->)#)
304                         {
305                                 $ret .= "$1 ";
306                         }
307                         $ret .= "<row> ";
309                         $i = 0;
310                         while ($line =~ m#<v>\s*([^<\s]+)\s*</v>#g)
311                         {
312                                 $values[$i] = $1;
313                                 $i++;
314                         }
316                         for (my $new_index = 0; $new_index < @$InDS; $new_index++)
317                         {
318                                 my $old_index = $ds_index->[$new_index];
319                                 $ret .= '<v> ' . $values[$old_index] . ' </v> ';
320                         }
321                         $ret .= "</row>\n";
322                 }
323         }
324         else
325         {
326                 die;
327         }
329         if ($ret)
330         {
331                 post_line ($ret, $index + 1);
332         }
333 }} # handle_line_dsmap
336 # The _step_ handler
339 my $step_factor_up;
340 my $step_factor_down;
341 sub handle_line_step
343         my $line = shift;
344         my $index = shift;
346         if (!$Step)
347         {
348                 post_line ($line, $index + 1);
349                 return;
350         }
352         $step_factor_up ||= 0;
353         $step_factor_down ||= 0;
355         if (($step_factor_up == 0) && ($step_factor_down == 0))
356         {
357                 if ($line =~ m#<step>\s*(\d+)\s*</step>#i)
358                 {
359                         my $old_step = 0 + $1;
360                         if ($Step < $old_step)
361                         {
362                                 $step_factor_down = int ($old_step / $Step);
363                                 if (($step_factor_down * $Step) != $old_step)
364                                 {
365                                         print STDERR "The old step ($old_step seconds) "
366                                         . "is not a multiple of the new step "
367                                         . "($Step seconds).\n";
368                                         exit (1);
369                                 }
370                                 $line = "<step> $Step </step>\n";
371                         }
372                         elsif ($Step > $old_step)
373                         {
374                                 $step_factor_up = int ($Step / $old_step);
375                                 if (($step_factor_up * $old_step) != $Step)
376                                 {
377                                         print STDERR "The new step ($Step seconds) "
378                                         . "is not a multiple of the old step "
379                                         . "($old_step seconds).\n";
380                                         exit (1);
381                                 }
382                                 $line = "<step> $Step </step>\n";
383                         }
384                         else
385                         {
386                                 $Step = 0;
387                         }
388                 }
389         }
390         elsif ($line =~ m#<pdp_per_row>\s*(\d+)\s*</pdp_per_row>#i)
391         {
392                 my $old_val = 0 + $1;
393                 my $new_val;
394                 if ($step_factor_up)
395                 {
396                         $new_val = int ($old_val / $step_factor_up);
397                         if (($new_val * $step_factor_up) != $old_val)
398                         {
399                                 print STDERR "Can't divide number of PDPs per row ($old_val) by step-factor ($step_factor_up).\n";
400                                 exit (1);
401                         }
402                 }
403                 else
404                 {
405                         $new_val = $step_factor_down * $old_val;
406                 }
407                 $line = "<pdp_per_row> $new_val </pdp_per_row>\n";
408         }
410         post_line ($line, $index + 1);
411 }} # handle_line_step
414 # The _add RRA_ handler
417 my $add_rra_done;
418 my $num_ds;
419 sub handle_line_add_rra
421   my $line = shift;
422   my $index = shift;
424   my $post = sub { for (@_) { post_line ($_, $index + 1); } };
426   $num_ds ||= 0;
428   if (!@$NewRRAs || $add_rra_done)
429   {
430     $post->($line);
431     return;
432   }
434   if ($line =~ m#<ds>#i)
435   {
436     $num_ds++;
437   }
438   elsif ($line =~ m#<rra>#i)
439   {
440     for (my $i = 0; $i < @$NewRRAs; $i++)
441     {
442       my $rra = $NewRRAs->[$i];
443       my $temp;
444       $post->("\t<rra>\n",
445       "\t\t<cf> $rra->{'cf'} </cf>\n",
446       "\t\t<pdp_per_row> $rra->{'steps'} </pdp_per_row>\n",
447       "\t\t<params>\n",
448       "\t\t\t<xff> $rra->{'xff'} </xff>\n",
449       "\t\t</params>\n",
450       "\t\t<cdp_prep>\n");
452       for (my $j = 0; $j < $num_ds; $j++)
453       {
454         $post->("\t\t\t<ds>\n",
455         "\t\t\t\t<primary_value> NaN </primary_value>\n",
456         "\t\t\t\t<secondary_value> NaN </secondary_value>\n",
457         "\t\t\t\t<value> NaN </value>\n",
458         "\t\t\t\t<unknown_datapoints> 0 </unknown_datapoints>\n",
459         "\t\t\t</ds>\n");
460       }
462       $post->("\t\t</cdp_prep>\n", "\t\t<database>\n");
463       $temp = "\t\t\t<row>" . join ('', map { "<v> NaN </v>" } (1 .. $num_ds)) . "</row>\n";
464       for (my $j = 0; $j < $rra->{'rows'}; $j++)
465       {
466         $post->($temp);
467       }
468       $post->("\t\t</database>\n");
469     }
470   }
472   $post->($line);
473 }} # handle_line_add_rra
476 # The _output_ handler
479 my $fh;
480 sub set_output
482         $fh = shift;
485 sub handle_line_output
487         my $line = shift;
488         my $index = shift;
490         if (!defined ($fh))
491         {
492                 post_line ($line, $index + 1);
493                 return;
494         }
495         
496         print $fh $line;
497 }} # handle_line_output
500 # Dispatching logic
503 my @handlers = ();
504 sub add_handler
506         my $handler = shift;
508         die unless (ref ($handler) eq 'CODE');
509         push (@handlers, $handler);
510 } # add_handler
512 sub post_line
514         my $line = shift;
515         my $index = shift;
517         if (0)
518         {
519                 my $copy = $line;
520                 chomp ($copy);
521                 print "DEBUG: post_line ($copy, $index);\n";
522         }
524         if ($index > $#handlers)
525         {
526                 return;
527         }
528         $handlers[$index]->($line, $index);
529 }} # post_line
531 sub handle_fh
533         my $in_fh = shift;
534         my $out_fh = shift;
536         set_output ($out_fh);
538         if (@$InDS)
539         {
540           add_handler (\&handle_line_dsmap);
541         }
543         if ($Step)
544         {
545           add_handler (\&handle_line_step);
546         }
548         if (@$NewRRAs)
549         {
550           add_handler (\&handle_line_add_rra);
551         }
553         add_handler (\&handle_line_output);
555         while (my $line = <$in_fh>)
556         {
557                 post_line ($line, 0);
558         }
559 } # handle_fh
561 sub main
563         my $in_file = shift;
564         my $out_file = shift;
566         my $in_fh;
567         my $out_fh;
569         my $in_needs_close = 1;
570         my $out_needs_close = 1;
572         if ($in_file =~ m/\.rrd$/i)
573         {
574                 open ($in_fh,  '-|', 'rrdtool', 'dump', $in_file) or die ("open (rrdtool): $!");
575         }
576         elsif ($in_file eq '-')
577         {
578                 $in_fh = \*STDIN;
579                 $in_needs_close = 0;
580         }
581         else
582         {
583                 open ($in_fh, '<', $in_file) or die ("open ($in_file): $!");
584         }
586         if ($out_file =~ m/\.rrd$/i)
587         {
588                 open ($out_fh, '|-', 'rrdtool', 'restore', '-', $out_file) or die ("open (rrdtool): $!");
589         }
590         elsif ($out_file eq '-')
591         {
592                 $out_fh = \*STDOUT;
593                 $out_needs_close = 0;
594         }
595         else
596         {
597                 open ($out_fh, '>', $out_file) or die ("open ($out_file): $!");
598         }
600         handle_fh ($in_fh, $out_fh);
602         if ($in_needs_close)
603         {
604                 close ($in_fh);
605         }
606         if ($out_needs_close)
607         {
608                 close ($out_fh);
609         }
610 } # main
612 =head1 LICENSE
614 This script is licensed under the GNU general public license, versionE<nbsp>2
615 (GPLv2).
617 =head1 AUTHOR
619 Florian octo Forster E<lt>octo at verplant.orgE<gt>