File Coverage

blib/lib/Dancer/Exception.pm

Criterion	Covered	Total	%
statement	72	75	96.0
branch	16	22	72.7
condition	10	12	83.3
subroutine	20	20	100.0
pod	6	6	100.0
total	124	135	91.8

package Dancer::Exception;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: class for throwing and catching exceptions
$Dancer::Exception::VERSION = '1.3514_04'; # TRIAL
$Dancer::Exception::VERSION = '1.351404';
use strict;
use warnings;
use Carp;
use Scalar::Util qw(blessed);

our $Verbose = 0;

use Dancer::Exception::Base;

use base qw(Exporter);

our @EXPORT_OK = (qw(try catch continuation register_exception registered_exceptions raise));
our %EXPORT_TAGS = ( all => \@EXPORT_OK );

use Try::Tiny ();

sub try (&;@) {
    goto &Try::Tiny::try;
}

sub catch (&;@) {
	my ( $block, @rest ) = @_;

    my $continuation_code;
    my @new_rest = grep { ref ne 'Try::Tiny::Catch' or $continuation_code = $$_, 0 } @rest;
    $continuation_code
      and return ( bless( \ sub {
          ref && blessed($_) && $_->isa('Dancer::Continuation')
            ? $continuation_code->(@_) : $block->(@_);
      },  'Try::Tiny::Catch') , @new_rest);

    return ( bless ( \ sub {
          ref && blessed($_) && $_->isa('Dancer::Continuation')
            ? die($_) : $block->(@_) ;
      }, 'Try::Tiny::Catch'), @new_rest );
}

sub continuation (&;@) {
	my ( $block, @rest ) = @_;

    my $catch_code;
    my @new_rest = grep { ref ne 'Try::Tiny::Catch' or $catch_code = $$_, 0 } @rest;
    $catch_code
      and return ( bless( \ sub {
          ref && blessed($_) && $_->isa('Dancer::Continuation')
            ? $block->(@_) : $catch_code->(@_);
      },  'Try::Tiny::Catch') , @new_rest);

    return ( bless ( \ sub {
          ref && blessed($_) && $_->isa('Dancer::Continuation')
            ? $block->(@_) : die($_);
      }, 'Try::Tiny::Catch'), @new_rest );
}

sub raise ($;@) {
    my $exception_name = shift;
    my $exception;
    if ($exception_name =~ s/^\+//) {
        $exception = $exception_name->new(@_);
    } else {
        _camelize($exception_name);
        $exception = "Dancer::Exception::$exception_name"->new(@_);
    }
    $exception->throw();
}

sub _camelize {
    # using aliasing for ease of use
    $_[0] =~ s/^(.)/uc($1)/e;
    $_[0] =~ s/_(.)/'::' . uc($1)/eg;
}

sub register_exception {
    my ($exception_name, %params) = @_;
    my $exception_class = 'Dancer::Exception::' . $exception_name;
    my $path = $exception_class; $path =~ s|::|/|g; $path .= '.pm';

    if (exists $INC{$path}) {
        local $Carp::CarpLevel = $Carp::CarpLevel++;
        'Dancer::Exception::Base::Internal'
            ->new("register_exception failed: $exception_name is already defined")
            ->throw;
    }

    my $message_pattern = $params{message_pattern};
    my $composed_from = $params{composed_from};
    my @composition = map { 'Dancer::Exception::' . $_ } @$composed_from;

    $INC{$path} = __FILE__;
    eval "\@${exception_class}::ISA=qw(Dancer::Exception::Base " . join (' ', @composition) . ');';

    if (defined $message_pattern) {
        no strict 'refs';
        *{"${exception_class}::_message_pattern"} = sub { $message_pattern };
    }

}

sub registered_exceptions {
    sort map { s|/|::|g; s/\.pm$//; $_ } grep { s|^Dancer/Exception/||; } keys %INC;
}

register_exception(@$_) foreach (
    [ 'Core',                message_pattern => 'core - %s' ],
    [ 'Core::App',           message_pattern => 'core - app - %s',         composed_from => [ qw(Core) ] ],
    [ 'Core::Config',        message_pattern => 'core - config - %s',      composed_from => [ qw(Core) ] ],
    [ 'Core::Deprecation',   message_pattern => 'core - deprecation - %s', composed_from => [ qw(Core) ] ],
    [ 'Core::Engine',        message_pattern => 'core - engine - %s',      composed_from => [ qw(Core) ] ],
    [ 'Core::Factory',       message_pattern => 'core - factory - %s',     composed_from => [ qw(Core) ] ],
    [ 'Core::Factory::Hook', message_pattern => 'core - hook - %s',        composed_from => [ qw(Core::Factory) ] ],
    [ 'Core::Hook',          message_pattern => 'core - hook - %s',        composed_from => [ qw(Core) ] ],
    [ 'Core::Fileutils',     message_pattern => 'core - file utils - %s',  composed_from => [ qw(Core) ] ],
    [ 'Core::Handler',       message_pattern => 'core - handler - %s',     composed_from => [ qw(Core) ] ],
    [ 'Core::Handler::PSGI', message_pattern => 'core - handler - %s',     composed_from => [ qw(Core::Handler) ] ],
    [ 'Core::Plugin',        message_pattern => 'core - plugin - %s',      composed_from => [ qw(Core) ] ],
    [ 'Core::Renderer',      message_pattern => 'core - renderer - %s',    composed_from => [ qw(Core) ] ],
    [ 'Core::Request',       message_pattern => 'core - request - %s',     composed_from => [ qw(Core) ] ],
    [ 'Core::Route',         message_pattern => 'core - route - %s',       composed_from => [ qw(Core) ] ],
    [ 'Core::Serializer',    message_pattern => 'core - serializer - %s',  composed_from => [ qw(Core) ] ],
    [ 'Core::Template',      message_pattern => 'core - template - %s',    composed_from => [ qw(Core) ] ],
    [ 'Core::Session',       message_pattern => 'core - session - %s',     composed_from => [ qw(Core) ] ],
);

1;

__END__