contrib/extractDS.px

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 =head1 NAME
   7
   8 extractDS.px - Extract a single data-source from an RRD-file
   9
  10 =head1 SYNOPSYS
  11
  12   extractDS.px -i input.rrd -s source_ds -o output.rrd -d destination_ds
  13
  14 =head1 DEPENDENCIES
  15
  16 extractDS.px requires Perl and the included L<Getopt::Long> module, as well as
  17 the L<XML::Simple> module.
  18
  19 =cut
  20
  21 use Getopt::Long ('GetOptions');
  22 use XML::Simple (qw(xml_in xml_out));
  23 use Data::Dumper ();
  24
  25 our $InFile;
  26 our $InDS;
  27 our $OutFile;
  28 our $OutDS;
  29
  30 GetOptions ("infile|i=s" => \$InFile,
  31         "inds|s=s" => \$InDS,
  32         "outfile|o=s" => \$OutFile,
  33         "outds|d=s" => \$OutDS) or exit (1);
  34
  35 if (!$InFile || !$OutFile || !$InDS || !$OutDS)
  36 {
  37         print "$InFile $InDS $OutFile $OutDS\n";
  38         print STDERR "Usage: $0 -i <infile> -I <inds> -o <outfile> -O <outds>\n";
  39         exit (1);
  40 }
  41 if (!-f $InFile)
  42 {
  43         print STDERR "Input file does not exist\n";
  44         exit (1);
  45 }
  46 if (-f $OutFile)
  47 {
  48         print STDERR "Output file does exist\n";
  49         exit (1);
  50 }
  51
  52 extract_ds ($InFile, $OutFile, $InDS, $OutDS);
  53 exit (0);
  54
  55 {
  56 my $ds_index = -1;
  57 my $current_index = -1;
  58 # state 0 == searching for DS index
  59 # state 1 == parse RRA header
  60 # state 2 == parse <ds> in RRA header
  61 # state 3 == parse values
  62 my $state = 0;
  63 my $out_cache = '';
  64 sub handle_line
  65 {
  66         my $fh = shift;
  67         my $line = shift;
  68
  69         if (!defined ($state))
  70         {
  71                 $ds_index = -1;
  72                 $current_index = -1;
  73                 $state = 0;
  74                 $out_cache = '';
  75         }
  76
  77         if ($state == 0)
  78         {
  79                 if ($line =~ m/<ds>/)
  80                 {
  81                         $out_cache = $line;
  82                         $current_index++;
  83                 }
  84                 elsif ($line =~ m#<name>\s*([^<\s]+)\s*</name>#)
  85                 {
  86                         if ($1 eq $InDS)
  87                         {
  88                                 $ds_index = $current_index;
  89                                 $out_cache .= "\t\t<name>$OutDS</name>\n";
  90                         }
  91                 }
  92                 elsif ($line =~ m#</ds>#)
  93                 {
  94                         $out_cache .= $line;
  95                         if ($ds_index == $current_index)
  96                         {
  97                                 print $fh $out_cache;
  98                         }
  99                 }
 100                 elsif ($line =~ m#<rra>#)
 101                 {
 102                         print $fh $line;
 103                         $current_index = -1;
 104                         $state = 1;
 105                 }
 106                 elsif ($current_index == -1)
 107                 {
 108                         print $fh $line;
 109                 }
 110                 else
 111                 {
 112                         $out_cache .= $line;
 113                 }
 114         }
 115         elsif ($state == 1)
 116         {
 117                 if ($line =~ m#<ds>#)
 118                 {
 119                         $current_index++;
 120                         if ($current_index == $ds_index)
 121                         {
 122                                 print $fh $line;
 123                         }
 124
 125                         if ($line =~ m#</ds>#) { $state = 1; }
 126                         else { $state = 2; }
 127                 }
 128                 elsif ($line =~ m#<database>#)
 129                 {
 130                         print $fh $line;
 131                         $state = 3;
 132                 }
 133                 else
 134                 {
 135                         print $fh $line;
 136                 }
 137         }
 138         elsif ($state == 2)
 139         {
 140                 if ($current_index == $ds_index)
 141                 {
 142                         print STDERR $line;
 143                         print $fh $line;
 144                 }
 145                 if ($line =~ m#</ds>#)
 146                 {
 147                         $state = 1;
 148                 }
 149         }
 150         else
 151         {
 152                 if ($line =~ m#</database>#)
 153                 {
 154                         print $fh $line;
 155                         $current_index = -1;
 156                         $state = 1;
 157                 }
 158                 else
 159                 {
 160                         my $line_begin = "\t\t";
 161                         $current_index = 0;
 162                         if ($line =~ m#(<!-- .*? -->)#)
 163                         {
 164                                 $line_begin .= "$1 ";
 165                         }
 166
 167                         while ($line =~ m#<v>\s*([^<\s]+)\s*</v>#)
 168                         {
 169                                 my $value = $1;
 170                                 if ($current_index == $ds_index)
 171                                 {
 172                                         print $fh "$line_begin<row> <v>$value</v> </row>\n";
 173                                         last;
 174                                 }
 175                                 $current_index++;
 176                         }
 177                 }
 178         }
 179 }} # handle_line
 180
 181 sub extract_ds
 182 {
 183         my $in_file = shift;
 184         my $out_file = shift;
 185         my $in_ds = shift;
 186         my $out_ds = shift;
 187
 188         my $in_fh;
 189         my $out_fh;
 190
 191         open ($in_fh,  '-|', 'rrdtool', 'dump', $in_file) or die ("open (rrdtool): $!");
 192         open ($out_fh, '|-', 'rrdtool', 'restore', '-', $out_file) or die ("open (rrdtool): $!");
 193
 194         while (my $line = <$in_fh>)
 195         {
 196                 handle_line ($out_fh, $line);
 197         }
 198
 199         close ($in_fh);
 200         close ($out_fh);
 201 } # extract_ds
 202
 203 =head1 AUTHOR
 204
 205 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 206