From 3e978894e009cbd57ad9376c29a0de845ad5e6de Mon Sep 17 00:00:00 2001 From: Aaron Trevena Date: Sat, 19 Nov 2005 18:16:34 +0000 Subject: [PATCH] simon cozens debug page and improved exceptions git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@430 48953598-375a-da11-a14b-00016c27c3ee --- Changes | 4 +++ lib/Maypole.pm | 21 ++++++++---- lib/Maypole/View/TT.pm | 77 +++++++++++++++++++++++++++++++++++++++++- 3 files changed, 94 insertions(+), 8 deletions(-) diff --git a/Changes b/Changes index e0b8a50..929ff96 100644 --- a/Changes +++ b/Changes @@ -36,6 +36,10 @@ API additions and enhancements: - added new path processing methods for ssl and default table/action - added make_path() - added make_uri() + - improved exception handling + Maypole::View::TT: + - new report_error method + - new embedded error report page in __DATA__ Templates: - Improved pager macro/include - added the status() attribute, although it's not used in many places diff --git a/lib/Maypole.pm b/lib/Maypole.pm index dbae33b..85d471f 100644 --- a/lib/Maypole.pm +++ b/lib/Maypole.pm @@ -515,7 +515,7 @@ sub handler_guts if ( my $error = $@ ) { - $status = $self->call_exception($error); + $status = $self->call_exception($error, "authentication"); if ( $status != OK ) { @@ -542,7 +542,7 @@ sub handler_guts if ( my $error = $@ ) { - $status = $self->call_exception($error); + $status = $self->call_exception($error, "model"); if ( $status != OK ) { @@ -595,7 +595,7 @@ sub __call_process_view if ( my $error = $@ ) { - $status = $self->call_exception($error); + $status = $self->call_exception($error, "view"); if ( $status != OK ) { @@ -823,16 +823,16 @@ exception method of your Maypole application. sub call_exception { - my ($self, $error) = @_; + my ($self, $error, $when) = @_; # Check if we have a model class with an exception() to delegate to if ( $self->model_class && $self->model_class->can('exception') ) { - my $status = $self->model_class->exception( $self, $error ); + my $status = $self->model_class->exception( $self, $error, $when ); return $status if $status == OK; } - return $self->exception($error); + return $self->exception($error, $when); } @@ -845,7 +845,14 @@ processed. =cut -sub exception { return ERROR } +sub exception { + my ($self, $error, $when) = @_; + if ($self->view_object->can("report_error") and $self->debug) { + $self->view_object->report_error($self, $error, $when); + return OK; + } + return ERROR; +} =item additional_data diff --git a/lib/Maypole/View/TT.pm b/lib/Maypole/View/TT.pm index 8b12deb..0280e1e 100644 --- a/lib/Maypole/View/TT.pm +++ b/lib/Maypole/View/TT.pm @@ -4,6 +4,9 @@ use Maypole::Constants; use Template; use File::Spec::Functions qw(catdir tmpdir); +our $error_template; +{ local $/; $error_template = ; } + use strict; our $VERSION = 2.11; @@ -36,7 +39,27 @@ sub template { } } -1; + +sub report_error { + my ($self, $r, $error, $type) = @_; + my $output; + # Need to be very careful here. + my $tt = Template->new; + if ($tt->process(\$error_template, + { err_type => $type, error => $error, + config => { %{$r->{config}}}, + request => $r, # We have that at least + eval{$self->vars($r)} }, \$output )) { + $r->{output} = $output; + if ($tt->error) { $r->{output} = "Even the error template + errored - ".$tt->error.""; } + $r->{content_type} ||= "text/html"; + $r->{document_encoding} ||= "utf-8"; + return OK; + } + return ERROR; +} + =head1 NAME @@ -298,3 +321,55 @@ Simon Cozens =cut +1; + +__DATA__ +Maypole error page + + +

Maypole application error

+ +

This application living at [%request.config.uri_base%], +[%request.config.application_name || "which is unnamed" %], has +produced an error. The adminstrator should be able to understand +this error message and fix the problem.

+ +

Some basic facts

+ +

The error was found in the [% err_type %] stage of processing +the path "[% request.path %]". The error text returned was: +

+
+    [% error %]
+
+ +

Request details

+ + + [% FOR thing = ["model_class", "table", "template", "path", + "content_type", "document_encoding", "action", "args", "objects"] %] + + [% END %] +
[%thing %] [% + request.$thing.list.join(" , ") %]
+ +

Application configuration

+ + [% FOR thing = config.keys %] + + [% END %] +
[%thing %] [% + config.$thing.list.join(" , ") %]
+ + + + + -- 2.39.5