package HTML::Mason::Exceptions;
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = 1.43;
my %e;
BEGIN
{
%e = ( 'HTML::Mason::Exception' =>
{ description => 'generic base class for all Mason exceptions',
alias => 'error'},
'HTML::Mason::Exception::Abort' =>
{ isa => 'HTML::Mason::Exception',
fields => [qw(aborted_value)],
description => 'a component called $m->abort' },
'HTML::Mason::Exception::Decline' =>
{ isa => 'HTML::Mason::Exception',
fields => [qw(declined_value)],
description => 'a component called $m->decline' },
'HTML::Mason::Exception::Compiler' =>
{ isa => 'HTML::Mason::Exception',
alias => 'compiler_error',
description => 'error thrown from the compiler' },
'HTML::Mason::Exception::Compilation' =>
{ isa => 'HTML::Mason::Exception',
alias => 'compilation_error',
fields => [qw(filename)],
description => "error thrown in eval of the code for a component" },
'HTML::Mason::Exception::Compilation::IncompatibleCompiler' =>
{ isa => 'HTML::Mason::Exception::Compilation',
alias => 'wrong_compiler_error',
description => "a component was compiled by a compiler/lexer with incompatible options. recompilation is needed" },
'HTML::Mason::Exception::Params' =>
{ isa => 'HTML::Mason::Exception',
alias => 'param_error',
description => 'invalid parameters were given to a method/function' },
'HTML::Mason::Exception::Syntax' =>
{ isa => 'HTML::Mason::Exception',
alias => 'syntax_error',
fields => [qw(source_line comp_name line_number)],
description => 'invalid syntax was found in a component' },
'HTML::Mason::Exception::System' =>
{ isa => 'HTML::Mason::Exception',
alias => 'system_error',
description => 'a system call of some sort failed' },
'HTML::Mason::Exception::TopLevelNotFound' =>
{ isa => 'HTML::Mason::Exception',
alias => 'top_level_not_found_error',
description => 'the top level component could not be found' },
'HTML::Mason::Exception::VirtualMethod' =>
{ isa => 'HTML::Mason::Exception',
alias => 'virtual_error',
description => 'a virtual method was not overridden' },
);
}
use Exception::Class (%e);
HTML::Mason::Exception->Trace(1);
# To avoid circular reference between exception and request.
HTML::Mason::Exception->NoRefs(1);
# The import() method allows this:
# use HTML::Mason::Exceptions(abbr => ['error1', 'error2', ...]);
# ...
# error1 "something went wrong";
sub import
{
my ($class, %args) = @_;
my $caller = caller;
if ($args{abbr})
{
foreach my $name (@{$args{abbr}})
{
no strict 'refs';
die "Unknown exception abbreviation '$name'" unless defined &{$name};
*{"${caller}::$name"} = \&{$name};
}
}
{
no strict 'refs';
*{"${caller}::isa_mason_exception"} = \&isa_mason_exception;
*{"${caller}::rethrow_exception"} = \&rethrow_exception;
}
}
sub isa_mason_exception
{
my ($err, $name) = @_;
return unless defined $err;
$name = $name ? "HTML::Mason::Exception::$name" : "HTML::Mason::Exception";
no strict 'refs';
die "no such exception class $name" unless $name->isa('HTML::Mason::Exception');
return UNIVERSAL::isa($err, $name);
}
sub rethrow_exception
{
my ($err) = @_;
return unless $err;
if ( UNIVERSAL::can($err, 'rethrow') ) {
$err->rethrow;
}
elsif ( ref $err ) {
die $err;
}
HTML::Mason::Exception->throw(error => $err);
}
package HTML::Mason::Exception;
use HTML::Mason::MethodMaker
( read_write => [ qw ( format ) ] );
sub new
{
my ($class, %params) = @_;
my $self = $class->SUPER::new(%params);
$self->format('text');
return $self;
}
# If we create a new exception from a Mason exception, just use the
# short error message, not the stringified exception. Otherwise
# exceptions can get stringified more than once.
sub throw
{
my $class = shift;
my %params = @_ == 1 ? ( error => $_[0] ) : @_;
if (HTML::Mason::Exceptions::isa_mason_exception($params{error})) {
$params{error} = $params{error}->error;
}
if (HTML::Mason::Exceptions::isa_mason_exception($params{message})) {
$params{message} = $params{message}->error;
}
$class->SUPER::throw(%params);
}
sub filtered_frames
{
my ($self) = @_;
my (@frames);
my $trace = $self->trace;
my %ignore_subs = map { $_ => 1 }
qw[
(eval)
Exception::Class::Base::throw
Exception::Class::__ANON__
HTML::Mason::Commands::__ANON__
HTML::Mason::Component::run
HTML::Mason::Exception::throw
HTML::Mason::Exceptions::__ANON__
HTML::Mason::Request::_run_comp
];
while (my $frame = $trace->next_frame)
{
last if ($frame->subroutine eq 'HTML::Mason::Request::exec');
unless ($frame->filename =~ /Mason\/Exceptions\.pm/ or
$ignore_subs{ $frame->subroutine } or
($frame->subroutine eq 'HTML::Mason::Request::comp' and $frame->filename =~ /Request\.pm/)) {
push(@frames, $frame);
}
}
@frames = grep { $_->filename !~ /Mason\/Exceptions\.pm/ } $trace->frames if !@frames;
return @frames;
}
sub analyze_error
{
my ($self) = @_;
my ($file, @lines, @frames);
return $self->{_info} if $self->{_info};
@frames = $self->filtered_frames;
if ($self->isa('HTML::Mason::Exception::Syntax')) {
$file = $self->comp_name;
push(@lines, $self->line_number);
} elsif ($self->isa('HTML::Mason::Exception::Compilation')) {
$file = $self->filename;
my $msg = $self->full_message;
while ($msg =~ /at .* line (\d+)./g) {
push(@lines, $1);
}
} elsif (@frames) {
$file = $frames[0]->filename;
@lines = $frames[0]->line;
}
my @context;
@context = $self->get_file_context($file, \@lines) if @lines;
$self->{_info} = {
file => $file,
frames => \@frames,
lines => \@lines,
context => \@context,
};
return $self->{_info};
}
sub get_file_context
{
my ($self, $file, $line_nums) = @_;
my @context;
my $fh = do { local *FH; *FH; };
unless (defined($file) and open($fh, $file)) {
@context = (['unable to open file', '']);
} else {
# Put the file into a list, indexed at 1.
my @file = <$fh>;
chomp(@file);
unshift(@file, undef);
# Mark the important context lines.
# We do this by going through the error lines and incrementing hash keys to
# keep track of which lines we eventually need to print, and we color the
# line which the error actually occured on in red.
my (%marks, %red);
my $delta = 4;
foreach my $line_num (@$line_nums) {
foreach my $l (($line_num - $delta) .. ($line_num + $delta)) {
next if ($l <= 0 or $l > @file);
$marks{$l}++;
}
$red{$line_num} = 1;
}
# Create the context list.
# By going through the keys of the %marks hash, we can tell which lines need
# to be printed. We add a '...' line if we skip numbers in the context.
my $last_num = 0;
foreach my $line_num (sort { $a <=> $b } keys %marks) {
push(@context, ["...", "", 0]) unless $last_num == ($line_num - 1);
push(@context, ["$line_num:", $file[$line_num], $red{$line_num}]);;
$last_num = $line_num;
}
push(@context, ["...", "", 0]) unless $last_num == @file;
close $fh;
}
return @context;
}
# basically the same as as_string in Exception::Class::Base
sub raw_text
{
my ($self) = @_;
return $self->full_message . "\n\n" . $self->trace->as_string;
}
sub as_string
{
my ($self) = @_;
my $stringify_function = "as_" . $self->{format};
return $self->$stringify_function();
}
sub as_brief
{
my ($self) = @_;
return $self->full_message;
}
sub as_line
{
my ($self) = @_;
my $info = $self->analyze_error;
(my $msg = $self->full_message) =~ s/\n/\t/g;
my $stack = join(", ", map { sprintf("[%s:%d]", $_->filename, $_->line) } @{$info->{frames}});
return sprintf("%s\tStack: %s\n", $msg, $stack);
}
sub as_text
{
my ($self) = @_;
my $info = $self->analyze_error;
my $msg = $self->full_message;
my $stack = join("\n", map { sprintf(" [%s:%d]", $_->filename, $_->line) } @{$info->{frames}});
return sprintf("%s\nStack:\n%s\n", $msg, $stack);
}
sub as_html
{
my ($self) = @_;
my $out;
my $interp = HTML::Mason::Interp->new(out_method => \$out);
my $comp = $interp->make_component(comp_source => <<'EOF');
<%args>
$msg
$info
$error
</%args>
<%filter>
s/(<td [^\>]+>)/$1<font face="Verdana, Arial, Helvetica, sans-serif" size="-2">/g;
s/<\/td>/<\/font><\/td>/g;
</%filter>
% HTML::Mason::Escapes::basic_html_escape(\$msg);
% $msg =~ s/\n/<br>/g;
<html><body>
<p align="center"><font face="Verdana, Arial, Helvetica, sans-serif"><b>System error</b></font></p>
<table border="0" cellspacing="0" cellpadding="1">
<tr>
<td nowrap="nowrap" align="left" valign="top"><b>error:</b> </td>
<td align="left" valign="top"><% $msg %></td>
</tr>
<tr>
<td nowrap="nowrap" align="left" valign="top"><b>context:</b> </td>
<td align="left" valign="top" nowrap="nowrap">
<table border="0" cellpadding="0" cellspacing="0">
% foreach my $entry (@{$info->{context}}) {
% my ($line_num, $line, $highlight) = @$entry;
% $line = '' unless defined $line;
% HTML::Mason::Escapes::basic_html_escape(\$line);
<tr>
<td nowrap="nowrap" align="left" valign="top"><b><% $line_num %></b> </td>
<td align="left" valign="top" nowrap="nowrap"><% $highlight ? "<font color=red>" : "" %><% $line %><% $highlight ? "</font>" : "" %></td>
</tr>
% }
</table>
</td>
</tr>
<tr>
<td align="left" valign="top" nowrap="nowrap"><b>code stack:</b> </td>
<td align="left" valign="top" nowrap="nowrap">
% foreach my $frame (@{$info->{frames}}) {
% my $f = $frame->filename; HTML::Mason::Escapes::basic_html_escape(\$f);
% my $l = $frame->line; HTML::Mason::Escapes::basic_html_escape(\$l);
<% $f %>:<% $l %><br>
% }
</td>
</tr>
</table>
<a href="#raw">raw error</a><br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
<br>
% my $raw = $error->raw_text;
% HTML::Mason::Escapes::basic_html_escape(\$raw);
% $raw =~ s/\t//g;
<a name="raw"></a>
<pre><% $raw %></pre>
</body></html>
EOF
$interp->exec($comp,
msg => $self->full_message,
info => $self->analyze_error,
error => $self);
return $out;
}
package HTML::Mason::Exception::Compilation;
sub full_message
{
my $self = shift;
return sprintf("Error during compilation of %s:\n%s\n", $self->filename || '', $self->message || '');
}
package HTML::Mason::Exception::Syntax;
sub full_message
{
my $self = shift;
return sprintf("%s at %s line %d", $self->message || '', $self->comp_name || '', $self->line_number);
}
1;
__END__
=pod
=head1 NAME
HTML::Mason::Exceptions - Exception objects thrown by Mason
=head1 VERSION
version 1.54
=head1 SYNOPSIS
use HTML::Mason::Exceptions ( abbr => [ qw(system_error) ] );
open FH, 'foo' or system_error "cannot open foo: $!";
=head1 DESCRIPTION
This module creates the hierarchy of exception objects used by Mason,
and provides some extra methods for them beyond those provided by
C<Exception::Class>
=head1 IMPORT
When this module is imported, it is possible to specify a list of
abbreviated function names that you want to use to throw exceptions.
In the L<SYNOPSIS|/SYNOPSIS> example, we use the C<system_error>
function to throw a C<HTML::Mason::Exception::System> exception.
These abbreviated functions do not allow you to set additional fields
in the exception, only the message.
=head1 EXCEPTIONS
=over
=item HTML::Mason::Exception
This is the parent class for all exceptions thrown by Mason. Mason
sometimes throws exceptions in this class when we could not find a
better category for the message.
Abbreviated as C<error>
=item HTML::Mason::Exception::Abort
The C<< $m->abort >> method was called.
Exceptions in this class contain the field C<aborted_value>.
=item HTML::Mason::Exception::Decline
The C<< $m->decline >> method was called.
Exceptions in this class contain the field C<declined_value>.
=item HTML::Mason::Exception::Compilation
An exception occurred when attempting to C<eval> an existing object
file.
Exceptions in this class have the field C<filename>, which indicates
what file contained the code that caused the error.
Abbreviated as C<compilation_error>.
=item HTML::Mason::Exception::Compiler
The compiler threw an exception because it received incorrect input.
For example, this would be thrown if the lexer told the compiler to
initialize compilation while it was in the middle of compiling another
component.
Abbreviated as C<compiler_error>.
=item HTML::Mason::Exception::Compilation::IncompatibleCompiler
A component was compiled by a compiler or lexer with incompatible
options. This is used to tell Mason to recompile a component.
Abbreviated as C<wrong_compiler_error>.
=item HTML::Mason::Exception::Params
Invalid parameters were passed to a method or function.
Abbreviated as C<param_error>.
=item HTML::Mason::Exception::Syntax
This exception indicates that a component contained invalid syntax.
Exceptions in this class have the fields C<source_line>, which is the
actual source where the error was found, C<comp_name>, and
C<line_number>.
Abbreviated as C<syntax_error>.
=item HTML::Mason::Exception::System
A system call of some sort, such as a file open, failed.
Abbreviated as C<system_error>.
=item HTML::Mason::Exception::TopLevelNotFound
The requested top level component could not be found.
Abbreviated as C<top_level_not_found_error>.
=item HTML::Mason::VirtualMethod
Some piece of code attempted to call a virtual method which was not
overridden.
Abbreviated as C<virtual_error>
=back
=head1 FIELDS
Some of the exceptions mentioned above have additional fields, which
are available via accessors. For example, to get the line number of
an C<HTML::Mason::Exception::Syntax> exception, you call the
C<line_number> method on the exception object.
=head1 EXCEPTION METHODS
All of the Mason exceptions implement the following methods:
=over
=item as_brief
This simply returns the exception message, without any trace information.
=item as_line
This returns the exception message and its trace information, all on a
single line with tabs between the message and each frame of the stack
trace.
=item as_text
This returns the exception message and stack information, with each
frame on a separate line.
=item as_html
This returns the exception message and stack as an HTML page.
=back
Each of these methods corresponds to a valid error_format parameter
for the L<Request object|HTML::Mason::Request> such as C<text> or
C<html>.
You can create your own method in the C<HTML::Mason::Exception>
namespace, such as C<as_you_wish>, in which case you could set this
parameter to "you_wish". This method will receive a single argument,
the exception object, and is expected to return some sort of string
containing the formatted error message.
=head1 EXCEPTION CLASS CHECKING
This module also exports the C<isa_mason_exception> function. This
function takes the exception object and an optional string parameter
indicating what subclass to check for.
So it can be called either as:
if ( isa_mason_exception($@) ) { ... }
or
if ( isa_mason_exception($@, 'Syntax') ) { ... }
Note that when specifying a subclass you should not include the
leading "HTML::Mason::Exception::" portion of the class name.
=head1 SEE ALSO
L<Mason|Mason>
=head1 AUTHORS
=over 4
=item *
Jonathan Swartz <swartz@pobox.com>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Ken Williams <ken@mathforum.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Jonathan Swartz.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut