workaround for memory-leak in debian squeeze librrds-perl (Bug #545519)

diff --git a/upsgraph.pl b/upsgraph.pl
index 9887d0c4ab2215e9b20eaecd4abf0cc23de55292..2783fcf75e86ba259cd0ddad1a3469f1a4eeb0f5 100755 (executable)
--- a/upsgraph.pl
+++ b/upsgraph.pl
@@ -1,5 +1,9 @@
 #!/usr/bin/perl -w
 
+#Due to memory leak in Debian squeeze (Bug #545519)
+my $use_rrds = 0;
+my $rrd_result = 0;
+
 if ((@ARGV != 1) && (@ARGV != 2)) {
        print STDERR "Syntax: ${0} configfile [uid]\n";
        exit(1);
@@ -23,6 +27,43 @@ my $step = $UPSGRAPH::step;
 my $keep = $UPSGRAPH::keep;
 my $hosts = $UPSGRAPH::hosts;
 
+sub rrd_update(@) {
+       my @args = @_;
+
+       if ($use_rrds == 1) {
+               RRDs::update(@args);
+               $rrd_result = RRDs::error;
+       } else {
+               $rrd_result = system("rrdtool", "update", @args);
+       }
+}
+
+sub rrd_graph(@) {
+       my @args = @_;
+       my @rrd_out = ();
+
+       if ($use_rrds == 1) {
+               @rrd_out = RRDs::graph(@args);
+               $rrd_result = RRDs::error;
+       } else {
+               my $rrd_stdout;
+
+               open(RRDFD, '-|', 'rrdtool', 'graph', @args);
+               while(<RRDFD>) {
+                       chomp;
+                       $rrd_stdout = $_;
+               }
+               close(RRDFD);
+               $rrd_result = $?;
+               if ($rrd_result == 0) {
+                       push @rrd_out, 0;
+                       push @rrd_out, split(/x/, $rrd_stdout);
+               }
+       }
+
+       return @rrd_out;
+}
+
 sub rrdcreate(@) {
        my $newrrd = shift;
        my $field = shift;
@@ -318,10 +359,10 @@ while(1) {
                        if (!(defined($vars->{$var}->{'value'}))) {
                                $vars->{$var}->{'value'} = 'U';
                        }
-                       RRDs::update("${rrdfile}.${var}", "N:" . $vars->{$var}->{'value'});
+                       rrd_update("${rrdfile}.${var}", "N:" . $vars->{$var}->{'value'});
                }
-               if (RRDs::error) {
-                       print "Error while updating: " . RRDs::error . "\n";
+               if ($rrd_result) {
+                       print "Error while updating: " . $rrd_result . "\n";
                }
 
                foreach my $var (@{$host->{'fields'}}) {
@@ -334,14 +375,14 @@ while(1) {
                        $mtime=(stat("${outdir}/${hostname}.${var}.png.work"))[9];
 
                        (my $averages, my $width, my $height) =
-                               RRDs::graph("${outdir}/${hostname}.${var}.png.work",
+                               rrd_graph("${outdir}/${hostname}.${var}.png.work",
                                                "-w", "720", @graphdef);
 
                        pop @graphdef;
                        pop @graphdef;
 
-                       if (RRDs::error) {
-                               print "Error while graphing: " . RRDs::error . "\n";
+                       if ($rrd_result) {
+                               print "Error while graphing: " . $rrd_result . "\n";
                        } else {
                                my $newmtime=(stat("${outdir}/${hostname}.${var}.png.work"))[9];
                                if ((!defined($mtime)) || ($newmtime != $mtime)) {
@@ -370,11 +411,11 @@ while(1) {
 
                        $mtime=(stat("${outdir}/${hostname}.${var}.long.png.work"))[9];
                        ($averages, $width, $height) =
-                               RRDs::graph("${outdir}/${hostname}.${var}.long.png.work",
+                               rrd_graph("${outdir}/${hostname}.${var}.long.png.work",
                                                "-w", "1008", @graphdef);
 
-                       if (RRDs::error) {
-                               print "Error while graphing: " . RRDs::error . "\n";
+                       if ($rrd_result) {
+                               print "Error while graphing: " . $rrd_result . "\n";
                        } else {
                                my $newmtime=(stat("${outdir}/${hostname}.${var}.long.png.work"))[9];
                                if ((!defined($mtime)) || ($newmtime != $mtime)) {
@@ -387,11 +428,11 @@ while(1) {
 
                        $mtime=(stat("${outdir}/${hostname}.${var}.week.png.work"))[9];
                        ($averages, $width, $height) =
-                               RRDs::graph("${outdir}/${hostname}.${var}.week.png.work",
+                               rrd_graph("${outdir}/${hostname}.${var}.week.png.work",
                                                "-w", "1008", "-e", "now", "-s", "end-1w", @graphdef);
 
-                       if (RRDs::error) {
-                               print "Error while graphing: " . RRDs::error . "\n";
+                       if ($rrd_result) {
+                               print "Error while graphing: " . $rrd_result . "\n";
                        } else {
                                my $newmtime=(stat("${outdir}/${hostname}.${var}.week.png.work"))[9];
                                if ((!defined($mtime)) || ($newmtime != $mtime)) {
@@ -404,11 +445,11 @@ while(1) {
 
                        $mtime=(stat("${outdir}/${hostname}.${var}.year.png.work"))[9];
                        ($averages, $width, $height) =
-                               RRDs::graph("${outdir}/${hostname}.${var}.year.png.work",
+                               rrd_graph("${outdir}/${hostname}.${var}.year.png.work",
                                                "-w", "1008", "-e", "now", "-s", "end-1y", @graphdef);
 
-                       if (RRDs::error) {
-                               print "Error while graphing: " . RRDs::error . "\n";
+                       if ($rrd_result) {
+                               print "Error while graphing: " . $rrd_result . "\n";
                        } else {
                                my $newmtime=(stat("${outdir}/${hostname}.${var}.year.png.work"))[9];
                                if ((!defined($mtime)) || ($newmtime != $mtime)) {