svn commit: r239295 - /perl/modperl/trunk/lib/Apache2/Status.pm

[pg...@apache.org]

Author: pgollucci
Date: Mon Aug 22 19:31:59 2005
New Revision: 239295

URL: http://svn.apache.org/viewcvs?rev=239295&view=rev
Log:
enhance the error handling for the Op Tree Graph link
which requires B::Graph and dot to be installed.

Previously, if dot wasn't found you got a 404 error.  Now, you get
a regular webpage with error message and and entry in the server error_log.


Modified:
    perl/modperl/trunk/lib/Apache2/Status.pm

Modified: perl/modperl/trunk/lib/Apache2/Status.pm
URL: http://svn.apache.org/viewcvs/perl/modperl/trunk/lib/Apache2/Status.pm?rev=239295&r1=239294&r2=239295&view=diff
==============================================================================
--- perl/modperl/trunk/lib/Apache2/Status.pm (original)
+++ perl/modperl/trunk/lib/Apache2/Status.pm Mon Aug 22 19:31:59 2005
@@ -707,9 +707,15 @@
     my $file = "$dir/$thing.$$.gif";
 
     unless (-e $file) {
-        tie *STDOUT, "B::Graph", $r, $file;
-        B::Graph::compile("-$type", $thing)->();
-        (tied *STDOUT)->{graph}->close;
+        my $rv = tie *STDOUT, "B::Graph", $r, $file;
+        unless ($rv) {
+            $r->content_type("text/plain");
+            $r->print("dot not found\n");
+        }
+        else {
+            B::Graph::compile("-$type", $thing)->();
+            (tied *STDOUT)->{graph}->close;
+        }
     }
 
     if (-s $file) {
@@ -745,13 +751,17 @@
 
     require IO::File;
     my $pipe = IO::File->new("|$dot -Tgif -o $file");
-    $pipe or die "can't open pipe to dot $!";
-    $pipe->autoflush(1);
+    $pipe && $pipe->autoflush(1);
 
-    return bless {
-                  graph => $pipe,
-                  r     => $r,
-    }, $class;
+    if ($pipe) {
+        return bless {
+            graph => $pipe,
+            r     => $r,
+        }, $class;
+    }
+    else {
+        return;
+    }
 }
 
 sub B::Graph::PRINT {