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 =item $answer = B<RRDp::read>
  49
  50 read RRDtool's response to your command. Note that the $answer variable will
  51 only contain a pointer to the returned data. The reason for this is, that
  52 RRDtool can potentially return quite excessive amounts of data
  53 and we don't want to copy this around in memory. So when you want to
  54 access the contents of $answer you have to use $$answer which dereferences
  55 the variable.
  56
  57 =item $status = B<RRDp::end>
  58
  59 terminates RRDtool and returns RRDtool's status ...
  60
  61 =item B<$RRDp::user>,  B<$RRDp::sys>, B<$RRDp::real>
  62
  63 these variables will contain totals of the user time, system time and
  64 real time as seen by RRDtool.  User time is the time RRDtool is
  65 running, System time is the time spend in system calls and real time
  66 is the total time RRDtool has been running.
  67
  68 The difference between user + system and real is the time spent
  69 waiting for things like the hard disk and new input from the perl
  70 script.
  71
  72 =item B<$RRDp::error_mode> and B<$RRDp::error>
  73
  74 If you set the variable $RRDp::error_mode to the value 'catch' before you run RRDp::read a potential
  75 ERROR message will not cause the program to abort but will be returned in this variable. If no error
  76 occurs the variable will be empty.
  77
  78  $RRDp::error_mode = 'catch';
  79  RRDp::cmd qw(info file.rrd);
  80  print $RRDp::error if $RRDp::error;
  81
  82 =back
  83
  84
  85 =head1 EXAMPLE
  86
  87  use RRDp;
  88  RRDp::start "/usr/local/bin/rrdtool";
  89  RRDp::cmd   qw(create demo.rrd --step 100
  90                DS:in:GAUGE:100:U:U
  91                RRA:AVERAGE:0.5:1:10);
  92  $answer = RRDp::read;
  93  print $$answer;
  94  ($usertime,$systemtime,$realtime) =  ($RRDp::user,$RRDp::sys,$RRDp::real);
  95
  96 =head1 SEE ALSO
  97
  98 For more information on how to use RRDtool, check the manpages.
  99
 100 =head1 AUTHOR
 101
 102 Tobias Oetiker <tobi@oetiker.ch>
 103
 104 =cut
 105 #'  this is to make cperl.el happy
 106
 107 use strict;
 108 use Fcntl;
 109 use Carp;
 110 use IO::Handle;
 111 use IPC::Open2;
 112 use vars qw($Sequence $RRDpid $VERSION);
 113 my $Sequence;
 114 my $RRDpid;
 115
 116 # Prototypes
 117
 118 sub start ($);
 119 sub cmd (@);
 120 sub end ();
 121 sub read ();
 122
 123 $VERSION=1.3000;
 124
 125 sub start ($){
 126   croak "rrdtool is already running"
 127     if defined $Sequence;
 128   $Sequence = 'S';
 129   my $rrdtool = shift @_;
 130   $RRDpid = open2 \*RRDreadHand,\*RRDwriteHand, $rrdtool,"-"
 131     or croak "Can't Start rrdtool: $!";
 132   RRDwriteHand->autoflush(); #flush after every write
 133   fcntl RRDreadHand, F_SETFL,O_NONBLOCK|O_NDELAY; #make readhandle NON BLOCKING
 134   return $RRDpid;
 135 }
 136
 137
 138 sub read () {
 139   croak "RRDp::read can only be called after RRDp::cmd"
 140     unless $Sequence eq 'C';
 141   $RRDp::error = undef;
 142   $Sequence = 'R';
 143   my $inmask = 0;
 144   my $srbuf;
 145   my $minibuf;
 146   my $buffer;
 147   my $nfound;
 148   my $timeleft;
 149   vec($inmask,fileno(RRDreadHand),1) = 1; # setup select mask for Reader
 150   while (1) {
 151     my $rout;
 152     $nfound = select($rout=$inmask,undef,undef,2);
 153     if ($nfound == 0 ) {
 154       # here, we could do something sensible ...
 155       next;
 156     }
 157     sysread(RRDreadHand,$srbuf,4096);
 158     $minibuf .= $srbuf;
 159     while ($minibuf =~ s|^(.+?)\n||s) {
 160       my $line = $1;
 161       # print $line,"\n";
 162       $RRDp::error = undef;
 163       if ($line =~  m|^ERROR|) {
 164         $RRDp::error_mode eq 'catch' ? $RRDp::error = $line : croak $line;
 165         $RRDp::sys = undef;
 166         $RRDp::user = undef;
 167         $RRDp::real = undef;
 168         return undef;
 169       }
 170       elsif ($line =~ m|^OK(?: u:([\d\.]+) s:([\d\.]+) r:([\d\.]+))?|){
 171         ($RRDp::sys,$RRDp::user,$RRDp::real)=($1,$2,$3);
 172         return \$buffer;
 173       } else {
 174         $buffer .= $line. "\n";
 175       }
 176     }
 177   }
 178 }
 179
 180 sub cmd (@){
 181   croak "RRDp::cmd can only be called after RRDp::read or RRDp::start"
 182     unless $Sequence eq 'R' or $Sequence eq 'S';
 183   $Sequence = 'C';
 184   my $cmd = join " ", @_;
 185   if ($Sequence ne 'S') {
 186   }
 187   $cmd =~ s/\n/ /gs;
 188   $cmd =~ s/\s/ /gs;
 189   print RRDwriteHand "$cmd\n";
 190 }
 191
 192 sub end (){
 193   croak "RRDp::end can only be called after RRDp::start"
 194     unless $Sequence;
 195   close RRDwriteHand;
 196   close RRDreadHand;
 197   $Sequence = undef;
 198   waitpid $RRDpid,0;
 199   return $?
 200 }
 201
 202 1;