there were two lines of debug info printed by rrd_xport, messing up the xml code...
[rrdtool.git] / bindings / perl-piped / RRDp.pm
index 046495a..31e1043 100644 (file)
@@ -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
 
@@ -69,6 +69,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 +99,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 +121,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 +139,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 +147,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 +159,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";
       }