File Coverage

blib/lib/HTML/Mason/Exceptions.pm

Criterion	Covered	Total	%
statement	137	145	94.4
branch	41	46	89.1
condition	20	23	86.9
subroutine	23	24	95.8
pod	5	15	33.3
total	226	253	89.3

package HTML::Mason::Exceptions;
$HTML::Mason::Exceptions::VERSION = '1.60';
use strict;
use warnings;

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;
$HTML::Mason::Exception::VERSION = '1.60';
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

<%filter>
 s/(
 s/<\/td>/<\/font><\/td>/g;


% HTML::Mason::Escapes::basic_html_escape(\$msg);
% $msg =~ s/\n//g;



System error
 




333




 





 





 





 





 





 



   




334




 





 





 





 





 





 



   error:  




335




 





 





 





 





 





 



   <% $msg %> 




336




 





 





 





 





 





 



   




337




 





 





 





 





 





 



   




338




 





 





 





 





 





 



   context:  




339




 





 





 





 





 





 



    




340




 





 





 





 





 





 



     




341




 





 





 





 





 





 



   




342




 





 





 





 





 





 



 %   foreach my $entry (@{$info->{context}}) { 




343




 





 





 





 





 





 



 %       my ($line_num, $line, $highlight) = @$entry; 




344




 





 





 





 





 





 



 %       $line = '' unless defined $line; 




345




 





 





 





 





 





 



 %       HTML::Mason::Escapes::basic_html_escape(\$line); 




346




 





 





 





 





 





 



      




347




 





 





 





 





 





 



      <% $line_num %>  




348




 





 





 





 





 





 



      <% $highlight ? "" : "" %><% $line %><% $highlight ? "" : "" %> 




349




 





 





 





 





 





 



      




350




 





 





 





 





 





 



   




351




 





 





 





 





 





 



 %    } 




352




 





 





 





 





 





 



   




353




 





 





 





 





 





 



     




354




 





 





 





 





 





 



    




355




 





 





 





 





 





 



   




356




 





 





 





 





 





 



   




357




 





 





 





 





 





 



   code stack:  




358




 





 





 





 





 





 



    




359




 





 





 





 





 





 



 %    foreach my $frame (@{$info->{frames}}) { 




360




 





 





 





 





 





 



 %        my $f = $frame->filename; HTML::Mason::Escapes::basic_html_escape(\$f); 




361




 





 





 





 





 





 



 %        my $l = $frame->line; HTML::Mason::Escapes::basic_html_escape(\$l); 




362




 





 





 





 





 





 



         <% $f %>:<% $l %> 




363




 





 





 





 





 





 



 %    } 




364




 





 





 





 





 





 



    




365




 





 





 





 





 





 



   




366







    




341




 





 





 





 





 





 



   




342




 





 





 





 





 





 



 %   foreach my $entry (@{$info->{context}}) { 




343




 





 





 





 





 





 



 %       my ($line_num, $line, $highlight) = @$entry; 




344




 





 





 





 





 





 



 %       $line = '' unless defined $line; 




345




 





 





 





 





 





 



 %       HTML::Mason::Escapes::basic_html_escape(\$line); 




346




 





 





 





 





 





 



      




347




 





 





 





 





 





 



      <% $line_num %>  




348




 





 





 





 





 





 



      <% $highlight ? "" : "" %><% $line %><% $highlight ? "" : "" %> 




349




 





 





 





 





 





 



      




350




 





 





 





 





 





 



   




351




 





 





 





 





 





 



 %    } 




352




 





 





 





 





 





 



   




353

%   foreach my $entry (@{$info->{context}}) {
%       my ($line_num, $line, $highlight) = @$entry;
%       $line = '' unless defined $line;
%       HTML::Mason::Escapes::basic_html_escape(\$line);





%    }







%    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 %>
%    }




raw error
































% my $raw = $error->raw_text;
% HTML::Mason::Escapes::basic_html_escape(\$raw);
% $raw =~ s/\t//g;



<% $raw %>


EOF

    $interp->exec($comp,
                  msg => $self->full_message,
                  info => $self->analyze_error,
                  error => $self);

    return $out;
}

package HTML::Mason::Exception::Compilation;
$HTML::Mason::Exception::Compilation::VERSION = '1.60';
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;
$HTML::Mason::Exception::Syntax::VERSION = '1.60';
sub full_message
{
    my $self = shift;

    return sprintf("%s at %s line %d", $self->message || '', $self->comp_name || '', $self->line_number);
}

1;

__END__