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
 106 #'  this is to make cperl.el happy
 107
 108 use strict;
 109 use Fcntl;
 110 use Carp;
 111 use IO::Handle;
 112 use IPC::Open2;
 113 use vars qw($Sequence $RRDpid $VERSION);
 114 my $Sequence;
 115 my $RRDpid;
 116
 117 # Prototypes
 118
 119 sub start ($);
 120 sub cmd (@);
 121 sub end ();
 122 sub read ();
 123
 124 $VERSION=1.3005;
 125
 126 sub start ($){
 127   croak "rrdtool is already running"
 128     if defined $Sequence;
 129   $Sequence = 'S';
 130   my $rrdtool = shift @_;
 131   $RRDpid = open2 \*RRDreadHand,\*RRDwriteHand, $rrdtool,"-"
 132     or croak "Can't Start rrdtool: $!";
 133   RRDwriteHand->autoflush(); #flush after every write
 134   fcntl RRDreadHand, F_SETFL,O_NONBLOCK|O_NDELAY; #make readhandle NON BLOCKING
 135   return $RRDpid;
 136 }
 137
 138
 139 sub read () {
 140   croak "RRDp::read can only be called after RRDp::cmd"
 141     unless $Sequence eq 'C';
 142   $RRDp::error = undef;
 143   $Sequence = 'R';
 144   my $inmask = 0;
 145   my $srbuf;
 146   my $minibuf;
 147   my $buffer;
 148   my $nfound;
 149   my $timeleft;
 150   vec($inmask,fileno(RRDreadHand),1) = 1; # setup select mask for Reader
 151   while (1) {
 152     my $rout;
 153     $nfound = select($rout=$inmask,undef,undef,2);
 154     if ($nfound == 0 ) {
 155       # here, we could do something sensible ...
 156       next;
 157     }
 158     sysread(RRDreadHand,$srbuf,4096);
 159     $minibuf .= $srbuf;
 160     while ($minibuf =~ s|^(.+?)\n||s) {
 161       my $line = $1;
 162       # print $line,"\n";
 163       $RRDp::error = undef;
 164       if ($line =~  m|^ERROR|) {
 165         $RRDp::error_mode eq 'catch' ? $RRDp::error = $line : croak $line;
 166         $RRDp::sys = undef;
 167         $RRDp::user = undef;
 168         $RRDp::real = undef;
 169         return undef;
 170       }
 171       elsif ($line =~ m|^OK(?: u:([\d\.]+) s:([\d\.]+) r:([\d\.]+))?|){
 172         ($RRDp::sys,$RRDp::user,$RRDp::real)=($1,$2,$3);
 173         return \$buffer;
 174       } else {
 175         $buffer .= $line. "\n";
 176       }
 177     }
 178   }
 179 }
 180
 181 sub cmd (@){
 182   croak "RRDp::cmd can only be called after RRDp::read or RRDp::start"
 183     unless $Sequence eq 'R' or $Sequence eq 'S';
 184   $Sequence = 'C';
 185   my $cmd = join " ", @_;
 186   if ($Sequence ne 'S') {
 187   }
 188   $cmd =~ s/\n/ /gs;
 189   $cmd =~ s/\s/ /gs;
 190   print RRDwriteHand "$cmd\n";
 191 }
 192
 193 sub end (){
 194   croak "RRDp::end can only be called after RRDp::start"
 195     unless $Sequence;
 196   close RRDwriteHand;
 197   close RRDreadHand;
 198   $Sequence = undef;
 199   waitpid $RRDpid,0;
 200   return $?
 201 }
 202
 203 1;