From 0e0570876e0cc48c447e39d18d17da44f91b7c68 Mon Sep 17 00:00:00 2001 From: Vernon Lyon Date: Thu, 29 Oct 2015 11:26:10 +0000 Subject: [PATCH 1/2] Use a table for the error stacktrace & show 5 lines of context --- lib/Dancer2/Core/Error.pm | 59 +++++++++------------------------ share/skel/public/css/error.css | 18 ++++++++-- 2 files changed, 32 insertions(+), 45 deletions(-) diff --git a/lib/Dancer2/Core/Error.pm b/lib/Dancer2/Core/Error.pm index 451e1e455..8b3ce6565 100644 --- a/lib/Dancer2/Core/Error.pm +++ b/lib/Dancer2/Core/Error.pm @@ -327,64 +327,37 @@ sub backtrace { } $message ||= 'Wooops, something went wrong'; - $message = '
' . _html_encode($message) . '
'; + my $html = '
' . _html_encode($message) . "
\n"; # the default perl warning/error pattern - my ( $file, $line ) = ( $message =~ /at (\S+) line (\d+)/ ); - + my ($file, $line) = $message =~ /at (\S+) line (\d+)/; # the Devel::SimpleTrace pattern - ( $file, $line ) = ( $message =~ /at.*\((\S+):(\d+)\)/ ) - unless $file and $line; + ($file, $line) = $message =~ /at.*\((\S+):(\d+)\)/ unless $file and $line; # no file/line found, cannot open a file for context - return $message unless ( $file and $line ); + return $html unless $file and $line; # file and line are located, let's read the source Luke! - my $fh = eval { open_file( '<', $file ) } or return $message; + my $fh = eval { open_file('<', $file) } or return $html; my @lines = <$fh>; close $fh; - my $backtrace = $message; - - $backtrace - .= qq|
| . "$file around line $line" . "
"; + $html .= qq|
$file around line $line
|; - $backtrace .= qq|
|;
+    # get 5 lines of context
+    my $start = $line - 5 > 1 ? $line - 5 : 1;
+    my $stop = $line + 5 < @lines ? $line + 5 : @lines;
 
-    $line--;
-    my $start = ( ( $line - 3 ) >= 0 ) ? ( $line - 3 ) : 0;
-    my $stop =
-      ( ( $line + 3 ) < scalar(@lines) ) ? ( $line + 3 ) : scalar(@lines);
+    $html .= qq|
\n|;
+    for my $l ($start .. $stop) {
+        chomp $lines[$l - 1];
 
-    for ( my $l = $start; $l <= $stop; $l++ ) {
-        chomp $lines[$l];
-
-        if ( $l == $line ) {
-            $backtrace
-              .= qq||
-              . tabulate( $l + 1, $stop + 1 )
-              . qq||
-              . _html_encode( $lines[$l] )
-              . "\n";
-        }
-        else {
-            $backtrace
-              .= qq||
-              . tabulate( $l + 1, $stop + 1 )
-              . " "
-              . _html_encode( $lines[$l] ) . "\n";
-        }
+        $html .= $l == $line ? '' : '';
+        $html .= "\n";
     }
-    $backtrace .= "";
-
-    return $backtrace;
-}
+    $html .= "
 
$l" . _html_encode($lines[$l - 1]) . "
\n";
 
-sub tabulate {
-    my ( $number, $max ) = @_;
-    my $len = length($max);
-    return $number if length($number) == $len;
-    return " $number";
+    return $html;
 }
 
 sub dumper {
diff --git a/share/skel/public/css/error.css b/share/skel/public/css/error.css
index 9cff07795..8a5e83173 100644
--- a/share/skel/public/css/error.css
+++ b/share/skel/public/css/error.css
@@ -54,9 +54,23 @@ div.title {
     padding-left: 10px;
 }
 
-pre.content span.nu {
+table.context {
+    border-spacing: 0;
+}
+
+table.context th, table.context td {
+    padding: 0;
+}
+
+table.context th {
     color: #889;
-    margin-right: 10px;
+    font-weight: normal;
+    padding-right: 15px;
+    text-align: right;
+}
+
+.errline {
+    color: red;
 }
 
 pre.error {

From 6a4b8d62e58f9943360e1d16e4db2b01d7db5b97 Mon Sep 17 00:00:00 2001
From: Vernon Lyon 
Date: Thu, 29 Oct 2015 11:09:10 +0000
Subject: [PATCH 2/2] Add Devel::StackTrace to errors

---
 dist.ini                  |  1 +
 lib/Dancer2/Core/App.pm   | 21 ++++++++++++++++-----
 lib/Dancer2/Core/Error.pm | 39 ++++++++++++++++++++++++++++++++++-----
 3 files changed, 51 insertions(+), 10 deletions(-)

diff --git a/dist.ini b/dist.ini
index 582adab15..5ea55c9dc 100644
--- a/dist.ini
+++ b/dist.ini
@@ -55,6 +55,7 @@ Moo::Role = 0
 Role::Tiny = 2.000000
 MooX::Types::MooseLike = 0
 Carp = 0
+Devel::StackTrace = 0
 Digest::SHA = 0
 Exporter = 5.57
 Encode = 0
diff --git a/lib/Dancer2/Core/App.pm b/lib/Dancer2/Core/App.pm
index 46394b4ef..e959853c2 100644
--- a/lib/Dancer2/Core/App.pm
+++ b/lib/Dancer2/Core/App.pm
@@ -9,6 +9,7 @@ use Return::MultiLevel ();
 use Safe::Isa;
 use Sub::Quote;
 use File::Spec;
+use Devel::StackTrace;
 
 use Plack::Middleware::FixMissingBodyInRedirect;
 use Plack::Middleware::Head;
@@ -1394,9 +1395,18 @@ sub _dispatch_route {
         return $self->_prep_response( $response );
     }
 
+    my $trace;
     $response = eval {
+        local $SIG{__DIE__} = sub {
+            my $end_trace;
+            $trace = Devel::StackTrace->new(
+                skip_frames => 1,
+                frame_filter => sub { $end_trace = 1 if $_[0]{caller}[0] eq 'Dancer2::Core::Route'; !$end_trace },
+            );
+            die @_;
+        };
         $route->execute($self)
-    } or return $self->response_internal_error($@);
+    } or return $self->response_internal_error($@, $trace);
 
     return $response;
 }
@@ -1419,7 +1429,7 @@ sub _prep_response {
 }
 
 sub response_internal_error {
-    my ( $self, $error ) = @_;
+    my ( $self, $error, $trace ) = @_;
 
     $self->log( error => "Route exception: $error" );
     $self->execute_hook( 'core.app.route_exception', $self, $error );
@@ -1428,9 +1438,10 @@ sub response_internal_error {
     local $Dancer2::Core::Route::RESPONSE = $self->response;
 
     return Dancer2::Core::Error->new(
-        app       => $self,
-        status    => 500,
-        exception => $error,
+        app         => $self,
+        status      => 500,
+        exception   => $error,
+       (stack_trace => $trace)x!! $trace,
     )->throw;
 }
 
diff --git a/lib/Dancer2/Core/Error.pm b/lib/Dancer2/Core/Error.pm
index 8b3ce6565..6707f66fa 100644
--- a/lib/Dancer2/Core/Error.pm
+++ b/lib/Dancer2/Core/Error.pm
@@ -7,6 +7,7 @@ use Dancer2::Core::Types;
 use Dancer2::Core::HTTP;
 use Data::Dumper;
 use Dancer2::FileUtils qw/path open_file/;
+use Devel::StackTrace;
 use Sub::Quote;
 
 has app => (
@@ -230,6 +231,13 @@ has content => (
     builder => '_build_content',
 );
 
+has stack_trace => (
+    is      => 'ro',
+    isa     => InstanceOf['Devel::StackTrace'],
+    lazy    => 1,
+    default => sub { Devel::StackTrace->new(ignore_package => __PACKAGE__) },
+);
+
 sub _build_content {
     my $self = shift;
 
@@ -407,12 +415,33 @@ sub get_caller {
     my ($self) = @_;
     my @stack;
 
-    my $deepness = 0;
-    while ( my ( $package, $file, $line ) = caller( $deepness++ ) ) {
-        push @stack, "$package in $file l. $line";
+    while (my $frame = $self->stack_trace->next_frame) {
+        my $html;
+        unless (@stack) {
+            $html = 'Trace begun at ';
+        } else {
+            if (my $eval = $frame->evaltext) {
+                if ($frame->is_require) {
+                    $html = 'require '.$eval;
+                } else {
+                    $eval =~ s/([\\\'])/\\$1/g;
+                    $html = "eval '$eval'";
+                }
+            } else {
+                $html = $frame->subroutine;
+                $html = 'eval {...}' if $html eq '(eval)';
+            }
+            $html = "$html(";
+            $html .= join ', ', map {
+                my $arg = Data::Dumper->new([$_])->Terse(1)->Indent(0)->Maxdepth(1)->Useqq(1)->Dump;
+                length $arg > 50 ? substr($arg, 0, 48).'...' : $arg;
+            } $frame->args;
+            $html .= ') called at ';
+        }
+        $html .= ''.$frame->filename.' line '.$frame->line.'';
+        push @stack, $html;
     }
-
-    return join( "\n", reverse(@stack) );
+    return join "\n", @stack;
 }
 
 # private