Show the index of each data source in the rrd_info output. Patch for #231 provided...

[rrdtool.git] / bindings / perl-piped / RRDp.pm

diff --git a/bindings/perl-piped/RRDp.pm b/bindings/perl-piped/RRDp.pm
index 046495a..c3fbf91 100644 (file)
--- a/bindings/perl-piped/RRDp.pm
+++ b/bindings/perl-piped/RRDp.pm
@@ -16,7 +16,7 @@ $answer = B<RRD::read>
 
 $status = B<RRD::end>
 
 
 $status = B<RRD::end>
 

-B<$RRDp::user>,  B<$RRDp::sys>, B<$RRDp::real>
+B<$RRDp::user>,  B<$RRDp::sys>, B<$RRDp::real>, B<$RRDp::error_mode>, B<$RRDp::error>

 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 


@@ -45,6 +45,9 @@ start RRDtool. The argument must be the path to the RRDtool executable
 pass commands on to RRDtool. check the RRDtool documentation for
 more info on the RRDtool commands.
 
 pass commands on to RRDtool. check the RRDtool documentation for
 more info on the RRDtool commands.
 

+B<Note>: Due to design limitations, B<RRDp::cmd> does not support the
+C<graph -> command - use C<graphv -> instead.
+

 =item $answer = B<RRDp::read>
 
 read RRDtool's response to your command. Note that the $answer variable will
 =item $answer = B<RRDp::read>
 
 read RRDtool's response to your command. Note that the $answer variable will


@@ -69,6 +72,16 @@ The difference between user + system and real is the time spent
 waiting for things like the hard disk and new input from the perl
 script.
 
 waiting for things like the hard disk and new input from the perl
 script.
 

+=item B<$RRDp::error_mode> and B<$RRDp::error>
+
+If you set the variable $RRDp::error_mode to the value 'catch' before you run RRDp::read a potential
+ERROR message will not cause the program to abort but will be returned in this variable. If no error
+occurs the variable will be empty.
+
+ $RRDp::error_mode = 'catch';
+ RRDp::cmd qw(info file.rrd);
+ print $RRDp::error if $RRDp::error;
+

 =back
 
 
 =back
 
 


@@ -89,9 +102,10 @@ For more information on how to use RRDtool, check the manpages.
 
 =head1 AUTHOR
 
 
 =head1 AUTHOR
 

-Tobias Oetiker <oetiker@ee.ethz.ch>
+Tobias Oetiker <tobi@oetiker.ch>

 
 =cut
 
 =cut

+

 #'  this is to make cperl.el happy
 
 use strict;
 #'  this is to make cperl.el happy
 
 use strict;


@@ -110,7 +124,7 @@ sub cmd (@);
 sub end ();
 sub read ();
 
 sub end ();
 sub read ();
 

-$VERSION=1.2002;
+$VERSION=1.3002;

 
 sub start ($){
   croak "rrdtool is already running"
 
 sub start ($){
   croak "rrdtool is already running"


@@ -128,6 +142,7 @@ sub start ($){
 sub read () {
   croak "RRDp::read can only be called after RRDp::cmd" 
     unless $Sequence eq 'C';
 sub read () {
   croak "RRDp::read can only be called after RRDp::cmd" 
     unless $Sequence eq 'C';

+  $RRDp::error = undef;

   $Sequence = 'R';
   my $inmask = 0;
   my $srbuf;
   $Sequence = 'R';
   my $inmask = 0;
   my $srbuf;


@@ -135,7 +150,6 @@ sub read () {
   my $buffer;
   my $nfound;
   my $timeleft;
   my $buffer;
   my $nfound;
   my $timeleft;

-  my $ERR = 0;

   vec($inmask,fileno(RRDreadHand),1) = 1; # setup select mask for Reader
   while (1) {
     my $rout;    
   vec($inmask,fileno(RRDreadHand),1) = 1; # setup select mask for Reader
   while (1) {
     my $rout;    


@@ -148,14 +162,18 @@ sub read () {
     $minibuf .= $srbuf;
     while ($minibuf =~ s|^(.+?)\n||s) {
       my $line = $1;
     $minibuf .= $srbuf;
     while ($minibuf =~ s|^(.+?)\n||s) {
       my $line = $1;

-      # print $line,"\n";
-      if ($line =~  m|^ERROR|) {
-       croak $line;
-       $ERR = 1;
+      # print $line,"\n";      
+      $RRDp::error = undef;
+      if ($line =~  m|^ERROR|) {       
+       $RRDp::error_mode eq 'catch' ? $RRDp::error = $line : croak $line;
+        $RRDp::sys = undef;
+        $RRDp::user = undef;
+        $RRDp::real = undef;
+       return undef;

       } 
       } 

-      elsif ($line =~ m|^OK u:([\d\.]+) s:([\d\.]+) r:([\d\.]+)|){
+      elsif ($line =~ m|^OK(?: u:([\d\.]+) s:([\d\.]+) r:([\d\.]+))?|){

        ($RRDp::sys,$RRDp::user,$RRDp::real)=($1,$2,$3);
        ($RRDp::sys,$RRDp::user,$RRDp::real)=($1,$2,$3);

-       return $ERR == 1 ? undef : \$buffer;
+       return \$buffer;

       } else {
        $buffer .= $line. "\n";
       }
       } else {
        $buffer .= $line. "\n";
       }


@@ -172,6 +190,13 @@ sub cmd (@){
   }
   $cmd =~ s/\n/ /gs;
   $cmd =~ s/\s/ /gs;
   }
   $cmd =~ s/\n/ /gs;
   $cmd =~ s/\s/ /gs;

+
+  # The generated graphs aren't necessarily terminated by a newline,
+  # causing RRDp::read() to wait for a line matching '^OK' forever.
+  if ($cmd =~ m/^\s*graph\s+-\s+/) {
+    croak "RRDp does not support the 'graph -' command - "
+        . "use 'graphv -' instead";
+  }

   print RRDwriteHand "$cmd\n";
 }
 
   print RRDwriteHand "$cmd\n";
 }