bindings/perl-piped/RRDp.pm

   1 package RRDp;
   2
   3 =head1 NAME
   4
   5 RRDp - Attach RRDtool from within a perl script via a set of pipes;
   6
   7 =head1 SYNOPSIS
   8
   9 use B<RRDp>
  10
  11 B<RRDp::start> I<path to RRDtool executable>
  12
  13 B<RRDp::cmd>  I<rrdtool commandline>
  14
  15 $answer = B<RRD::read>
  16
  17 $status = B<RRD::end>
  18
  19 B<$RRDp::user>,  B<$RRDp::sys>, B<$RRDp::real>, B<$RRDp::error_mode>, B<$RRDp::error>
  20
  21 =head1 DESCRIPTION
  22
  23 With this module you can safely communicate with the RRDtool.
  24
  25 After every B<RRDp::cmd> you have to issue an B<RRDp::read> command to get
  26 B<RRDtool>s answer to your command. The answer is returned as a pointer,
  27 in order to speed things up. If the last command did not return any
  28 data, B<RRDp::read> will return an undefined variable.
  29
  30 If you import the PERFORMANCE variables into your namespace,
  31 you can access RRDtool's internal performance measurements.
  32
  33 =over 8
  34
  35 =item  use B<RRDp>
  36
  37 Load the RRDp::pipe module.
  38
  39 =item B<RRDp::start> I<path to RRDtool executable>
  40
  41 start RRDtool. The argument must be the path to the RRDtool executable
  42
  43 =item B<RRDp::cmd> I<rrdtool commandline>
  44
  45 pass commands on to RRDtool. check the RRDtool documentation for
  46 more info on the RRDtool commands.
  47
  48 B<Note>: Due to design limitations, B<RRDp::cmd> does not support the
  49 C<graph -> command - use C<graphv -> instead.
  50
  51 =item $answer = B<RRDp::read>
  52
  53 read RRDtool's response to your command. Note that the $answer variable will
  54 only contain a pointer to the returned data. The reason for this is, that
  55 RRDtool can potentially return quite excessive amounts of data
  56 and we don't want to copy this around in memory. So when you want to
  57 access the contents of $answer you have to use $$answer which dereferences
  58 the variable.
  59
  60 =item $status = B<RRDp::end>
  61
  62 terminates RRDtool and returns RRDtool's status ...
  63
  64 =item B<$RRDp::user>,  B<$RRDp::sys>, B<$RRDp::real>
  65
  66 these variables will contain totals of the user time, system time and
  67 real time as seen by RRDtool.  User time is the time RRDtool is
  68 running, System time is the time spend in system calls and real time
  69 is the total time RRDtool has been running.
  70
  71 The difference between user + system and real is the time spent
  72 waiting for things like the hard disk and new input from the perl
  73 script.
  74
  75 =item B<$RRDp::error_mode> and B<$RRDp::error>
  76
  77 If you set the variable $RRDp::error_mode to the value 'catch' before you run RRDp::read a potential
  78 ERROR message will not cause the program to abort but will be returned in this variable. If no error
  79 occurs the variable will be empty.
  80
  81  $RRDp::error_mode = 'catch';
  82  RRDp::cmd qw(info file.rrd);
  83  print $RRDp::error if $RRDp::error;
  84
  85 =back
  86
  87
  88 =head1 EXAMPLE
  89
  90  use RRDp;
  91  RRDp::start "/usr/local/bin/rrdtool";
  92  RRDp::cmd   qw(create demo.rrd --step 100
  93                DS:in:GAUGE:100:U:U
  94                RRA:AVERAGE:0.5:1:10);
  95  $answer = RRDp::read;
  96  print $$answer;
  97  ($usertime,$systemtime,$realtime) =  ($RRDp::user,$RRDp::sys,$RRDp::real);
  98
  99 =head1 SEE ALSO
 100
 101 For more information on how to use RRDtool, check the manpages.
 102
 103 =head1 AUTHOR
 104
 105 Tobias Oetiker <tobi@oetiker.ch>
 106
 107 =cut
 108
 109 #'  this is to make cperl.el happy
 110
 111 use strict;
 112 use Fcntl;
 113 use Carp;
 114 use IO::Handle;
 115 use IPC::Open2;
 116 use vars qw($Sequence $RRDpid $VERSION);
 117 my $Sequence;
 118 my $RRDpid;
 119
 120 # Prototypes
 121
 122 sub start ($);
 123 sub cmd (@);
 124 sub end ();
 125 sub read ();
 126
 127 $VERSION=1.3002;
 128
 129 sub start ($){
 130   croak "rrdtool is already running"
 131     if defined $Sequence;
 132   $Sequence = 'S';
 133   my $rrdtool = shift @_;
 134   $RRDpid = open2 \*RRDreadHand,\*RRDwriteHand, $rrdtool,"-"
 135     or croak "Can't Start rrdtool: $!";
 136   RRDwriteHand->autoflush(); #flush after every write
 137   fcntl RRDreadHand, F_SETFL,O_NONBLOCK|O_NDELAY; #make readhandle NON BLOCKING
 138   return $RRDpid;
 139 }
 140
 141
 142 sub read () {
 143   croak "RRDp::read can only be called after RRDp::cmd"
 144     unless $Sequence eq 'C';
 145   $RRDp::error = undef;
 146   $Sequence = 'R';
 147   my $inmask = 0;
 148   my $srbuf;
 149   my $minibuf;
 150   my $buffer;
 151   my $nfound;
 152   my $timeleft;
 153   vec($inmask,fileno(RRDreadHand),1) = 1; # setup select mask for Reader
 154   while (1) {
 155     my $rout;
 156     $nfound = select($rout=$inmask,undef,undef,2);
 157     if ($nfound == 0 ) {
 158       # here, we could do something sensible ...
 159       next;
 160     }
 161     sysread(RRDreadHand,$srbuf,4096);
 162     $minibuf .= $srbuf;
 163     while ($minibuf =~ s|^(.+?)\n||s) {
 164       my $line = $1;
 165       # print $line,"\n";
 166       $RRDp::error = undef;
 167       if ($line =~  m|^ERROR|) {
 168         $RRDp::error_mode eq 'catch' ? $RRDp::error = $line : croak $line;
 169         $RRDp::sys = undef;
 170         $RRDp::user = undef;
 171         $RRDp::real = undef;
 172         return undef;
 173       }
 174       elsif ($line =~ m|^OK(?: u:([\d\.]+) s:([\d\.]+) r:([\d\.]+))?|){
 175         ($RRDp::sys,$RRDp::user,$RRDp::real)=($1,$2,$3);
 176         return \$buffer;
 177       } else {
 178         $buffer .= $line. "\n";
 179       }
 180     }
 181   }
 182 }
 183
 184 sub cmd (@){
 185   croak "RRDp::cmd can only be called after RRDp::read or RRDp::start"
 186     unless $Sequence eq 'R' or $Sequence eq 'S';
 187   $Sequence = 'C';
 188   my $cmd = join " ", @_;
 189   if ($Sequence ne 'S') {
 190   }
 191   $cmd =~ s/\n/ /gs;
 192   $cmd =~ s/\s/ /gs;
 193
 194   # The generated graphs aren't necessarily terminated by a newline,
 195   # causing RRDp::read() to wait for a line matching '^OK' forever.
 196   if ($cmd =~ m/^\s*graph\s+-\s+/) {
 197     croak "RRDp does not support the 'graph -' command - "
 198         . "use 'graphv -' instead";
 199   }
 200   print RRDwriteHand "$cmd\n";
 201 }
 202
 203 sub end (){
 204   croak "RRDp::end can only be called after RRDp::start"
 205     unless $Sequence;
 206   close RRDwriteHand;
 207   close RRDreadHand;
 208   $Sequence = undef;
 209   waitpid $RRDpid,0;
 210   return $?
 211 }
 212
 213 1;