[Mungo-devel] [mungo commit] r48 - in trunk/lib: . Mungo

svn-commit at lists.omniti.com svn-commit at lists.omniti.com
Mon Aug 10 11:58:56 EDT 2009


Author: clinton
Date: 2009-08-10 11:58:56 -0400 (Mon, 10 Aug 2009)
New Revision: 48

Added:
   trunk/lib/Mungo/Quiet.pm
Modified:
   trunk/lib/Mungo.pm
   trunk/lib/Mungo/Response.pm
Log:
Adding debugging for error handling, and also a queiter error handler

Added: trunk/lib/Mungo/Quiet.pm
===================================================================
--- trunk/lib/Mungo/Quiet.pm	                        (rev 0)
+++ trunk/lib/Mungo/Quiet.pm	2009-08-10 15:58:56 UTC (rev 48)
@@ -0,0 +1,134 @@
+package Mungo::Quiet;
+use strict;
+use warnings;
+
+use Apache2::Const qw ( OK NOT_FOUND SERVER_ERROR );
+
+our $DEBUG = 2;
+
+sub handler($$) {
+    my ($invocant, $r) = @_;
+    my $mungo_class;
+    if (ref $invocant eq 'Apache2::RequestRec') {
+        # Called as subroutine
+        $r = $invocant;
+        $mungo_class = 'Mungo';
+    } else {
+        # Called as class method
+        $mungo_class = 'Mungo';   # Override this
+        # $r is already right
+    }
+
+    if ($DEBUG) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- Have filename " . $r->filename . "\n"; }
+
+    # Short circuit if we can't find the file.
+    return NOT_FOUND if(! -r $r->filename);
+
+    my $self = $mungo_class->new($r);
+
+    # Initialize Mungo environment
+    $self->Response()->start();
+
+
+    #local $SIG{__DIE__} = \&quieterMungoErrors;
+    $self->{data}->{OnError} = \&quieterMungoErrors;
+
+    # All exits from the Include - including Redirect, End, and die()ing
+    # will end up with a 'goto MUNGO_HANDLER_FINISH'
+
+    eval {
+        $main::Request = $self->Request();
+        $main::Response = $self->Response();
+        $main::Server = $self->Server();
+        if ($DEBUG) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- Entering Include \n"; }
+        $self->Response()->Include($r->filename);
+        if ($DEBUG) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- Survived Include \n"; }
+    };
+
+
+    # CODE HERE WILL NEVER GET EXECUTED
+    if ($@) {
+        if ($DEBUG) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- Eval threw exception: \n$@\n"; }
+    }
+
+
+
+    # gotos come here from:
+    #   $Response->End()
+  MUNGO_HANDLER_FINISH:
+    $self->Response()->finish();
+    $self->cleanse();
+    undef $main::Request;
+    undef $main::Response;
+    undef $main::Server;
+    return $self->{data}->{ApacheResponseCode} || OK;
+}
+
+
+sub quieterMungoErrors {
+    my $response = shift; # A Mungo::Response object
+    my $error = shift; # A Mungo::Error object, or a plain string
+    my $subject = shift; # Either a coderef or a filename
+
+    if ($DEBUG) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- In qME\n"; }
+
+    my $have_obj = ref $error;
+    my $errstr = $have_obj ? $error->{error} : $error;
+
+
+    # Most importantly, set the apache error response
+    $response->{Mungo}->{data}->{ApacheResponseCode} = SERVER_ERROR;
+
+    print STDERR "Mungo error in file $subject:\n";
+    print STDERR "\t $errstr \n";
+
+    unless ($have_obj) {
+        return;
+    }
+
+    # caller columns:
+    #  0         1          2      3            4         5           6          7            8       9
+    my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask) = (0..9);
+    my @callstack = @{$error->{callstack}};
+
+    # Print basic trace
+    print STDERR "Mungo stack trace:\n";
+    foreach my $frame (@callstack) {
+        print STDERR "\t" . $frame->[$package] . "\t" . $frame->[$filename] . "\t" .$frame->[$line] . "\t" . $frame->[$subroutine] . "\n";
+
+    }
+
+    # Try to obtain source code from mungo coderefs
+    my $pkg = $callstack[0][$package];
+    my $preamble = eval "\$${pkg}::Mungo_preamble;";
+    my $postamble = eval "\$${pkg}::Mungo_postamble;";
+    my $contents = eval "\$${pkg}::Mungo_contents;";
+
+    # If that failed, try to read the file?
+    unless ($contents) {
+        my $file = $callstack[0][$filename];
+        if (open(FILE, "<$file")) {
+            local $/ = undef;
+            $contents = <FILE>;
+            close(FILE);
+        }
+    }
+
+    # If that didn't work, try the eval text.
+    unless ($contents) {
+        $contents = $callstack[0][$evaltext];
+    }
+
+    if ($contents) {
+        print STDERR Mungo::Utils::pretty_print_code($preamble, $contents, $postamble, $callstack[0][$line]);
+    } else {
+        print STDERR Dumper($@) . "\n";
+    }
+
+    # Jump to exit
+    eval { goto  MUNGO_HANDLER_FINISH; }; # Jump back to Mungo::handler()
+
+}
+
+
+1;

Modified: trunk/lib/Mungo/Response.pm
===================================================================
--- trunk/lib/Mungo/Response.pm	2009-06-15 22:36:39 UTC (rev 47)
+++ trunk/lib/Mungo/Response.pm	2009-08-10 15:58:56 UTC (rev 48)
@@ -70,6 +70,9 @@
 use HTML::Entities;
 our $AUTOLOAD;
 
+our $DEBUG = 0;
+use Data::Dumper;
+
 my $one_true_buffer = '';
 
 sub new {
@@ -226,43 +229,46 @@
 =cut
 
 sub Include {
-  my $self = shift;
-  my $subject = shift;
-  my $_r = tied %$self;
-  my $rv;
-  eval {
-    local $SIG{__DIE__} = \&Mungo::MungoDie;
-    if(ref $subject) {
-      $rv = $_r->{data}->{Mungo}->include_mem($subject, @_);
-    }
-    else {
-      $rv = $_r->{data}->{Mungo}->include_file($subject, @_);
-    }
-  };
-  if($@) {
-    # If we have more than 1 item in the IO stack, we should just re-raise.
-    if (scalar(@{$_r->{data}->{'IO_stack'} || []}) > 1) {
-      local $SIG{__DIE__} = undef;
-      die $@;
-    }
-    my $hashref = $@;
+    my $self = shift;
+    my $subject = shift;
+    my $_r = tied %$self;
+    my $rv;
     eval {
-      if($_r->{data}->{OnError}) {
-        $_r->{data}->{OnError}->($self, $hashref, $subject);
-      }
-      else {
-        $self->defaultErrorHandler($hashref, $subject);
-      }
+        local $SIG{__DIE__} = \&Mungo::wrapErrorsInObjects;
+        if(ref $subject) {
+            $rv = $_r->{data}->{Mungo}->include_mem($subject, @_);
+        } else {
+            $rv = $_r->{data}->{Mungo}->include_file($subject, @_);
+        }
     };
     if($@) {
-      # Oh, dear lord this is bad.  We'd died trying to print out death.
-      print STDERR "Mungo::Response -> die in error renderer\n";
-      print STDERR $hashref;
-      print STDERR $@;
+        if ($DEBUG) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- Have level one error: $@\n"; }
+
+        # If we have more than 1 item in the IO stack, we should just re-raise.
+        if (scalar(@{$_r->{data}->{'IO_stack'} || []}) > 1) {
+            local $SIG{__DIE__} = undef;
+            if ($DEBUG > 1) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- rethrowing\n"; }
+            die $@;
+        }
+        my $hashref = $@;
+        eval {
+            if($_r->{data}->{OnError}) {
+                if ($DEBUG > 1) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- have custom error handler, calling\n"; }
+                $_r->{data}->{OnError}->($self, $hashref, $subject);
+            } else {
+                if ($DEBUG > 1) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- no custom error handler, using default\n"; }
+                $self->defaultErrorHandler($hashref, $subject);
+            }
+        };
+        if ($@) {
+            # Oh, dear lord this is bad.  We'd died trying to print out death.
+            print STDERR "Mungo::Response -> die in error renderer\n";
+            print STDERR $hashref;
+            print STDERR $@;
+        }
+        return undef;
     }
-    return undef;
-  }
-  return $rv;
+    return $rv;
 }
 
 sub defaultErrorHandler {
@@ -271,6 +277,8 @@
   my $href = shift; # Our Error
   my $subject = shift;
   my $_r = tied %$self;
+  if ($DEBUG > 1) { print STDERR __PACKAGE__ . ':' . __LINE__ . "- in default error handler\n"; }
+
   print "Error in Include($subject):<br />\n";
   my $pkg = $href->{callstack}->[0]->[0];
   my $preamble = eval "\$${pkg}::Mungo_preamble;";

Modified: trunk/lib/Mungo.pm
===================================================================
--- trunk/lib/Mungo.pm	2009-06-15 22:36:39 UTC (rev 47)
+++ trunk/lib/Mungo.pm	2009-08-10 15:58:56 UTC (rev 48)
@@ -226,7 +226,7 @@
 
   $self = $self->new($r) unless(ref $self);
   $self->Response()->start();
-  local $SIG{__DIE__} = \&Mungo::MungoDie;
+  local $SIG{__DIE__} = \&Mungo::wrapErrorsInObjects;
   eval {
     $main::Request = $self->Request();
     $main::Response = $self->Response();
@@ -254,7 +254,7 @@
 }
 
 
-sub MungoDie {
+sub wrapErrorsInObjects {
   my $i = 0;
   my @callstack;
   while(my @callinfo = caller($i++)) {



More information about the Mungo-devel mailing list