—

              
package Dancer::Exception::Base;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: the base class of all Dancer exceptions
$Dancer::Exception::Base::VERSION = '1.3521';
use strict;
use warnings;
use Carp;
use base qw(Exporter);
use Dancer::Exception;
use overload '""' => sub {
    my ($self) = @_;
    $self->message
      . ( $Dancer::Exception::Verbose ? $self->{_longmess} : $self->{_shortmess});
};
# string comparison is done without the stack traces
use overload 'cmp' => sub {
    my ($e, $f) = @_;
    ( ref $e && $e->isa(__PACKAGE__)
      ? $e->message : $e )
      cmp
    ( ref $f && $f->isa(__PACKAGE__)
      ? $f->message : $f )
};
# This is the base class of all exceptions
sub new {
    my $class = shift;
    my $self = bless { _raised_arguments => [],
                       _shortmess => '',
                       _longmess => '',
                     }, $class;
    $self->_raised_arguments(@_);
    return $self;
}
# base class has a passthrough message
sub _message_pattern { '%s' }
sub throw {
    my $self = shift;
    $self->_raised_arguments(@_);
    local $Carp::CarpInternal;
    local $Carp::Internal;
    $Carp::Internal{'Dancer'} ++;
    $Carp::CarpInternal{'Dancer::Exception'} ++;
    $self->{_shortmess} = Carp::shortmess;
    $self->{_longmess} = Carp::longmess;
    die $self;
}
sub rethrow { die $_[0] }
sub message {
    my ($self) = @_;
    my $message_pattern = $self->_message_pattern;
    my $message = sprintf($message_pattern, @{$self->_raised_arguments});
    return $message;
}
sub does {
    my $self = shift;
    my $regexp = join('|', map { '^' . $_ . '$'; } @_);
    (scalar grep { /$regexp/ } $self->get_composition) >= 1;
}
sub get_composition {
    my ($self) = @_;
    my $class = ref($self);
    my ($_recurse_isa, %seen);
    $_recurse_isa = sub {
        my ($class) = @_;
        $seen{$class}++
          and return;
        no strict 'refs';
        return $class, map { $_recurse_isa->($_) }
                      grep { /^Dancer::Exception::/ }
                          @{"${class}::ISA"};
         
    };
    grep { s/^Dancer::Exception::// } $_recurse_isa->($class);
}
sub _raised_arguments {
    my $self = shift;
    @_ and $self->{_raised_arguments} = [ @_ ];
    $self->{_raised_arguments};
}
1;
__END__
HideShow 137 lines of Pod
=pod
=encoding UTF-8
=head1 NAME
Dancer::Exception::Base - the base class of all Dancer exceptions
=head1 VERSION
version 1.3521
=head1 DESCRIPTION
Dancer::Exception::Base is the base class of all Dancer exception. All core
exceptions, and all custom exception registered using
C<Dancer::Exception::register_exception> inherits of
C<Dancer::Exception::Base>.
=head1 METHODS
=head2 throw
Throws an exception. It's what C<raise> (from L<Dancer::Exception>) uses. Any
arguments is set as raising parameters. You should not use this method
directly, but instead, use C<raise> from L<Dancer::Exception>.
B<Warning>, if you want to rethrow an exception, use C<rethrow>.
=head2 rethrow
Re-throw the exception, without touching its parameters. Useful if you've
caught and exception but don't want to handle it, and want to rethrow it.
  try { ... }
  catch {
    my ($e) = @_;
    $e->does('InvalidLogin')
      or $e->rethrow;
    ...
  };
=head2 does
Given an exception type, returns true if the exception is of the same type.
  try { raise InvalidLogin => 'foo'; }
  catch {
    my ($e) = @_;
    $e->does('InvalidLogin') # true
    ...
  };
It can receive more than one type, useful for composed exception, or checking
multiple types at once. C<does> performs a logical OR between them:
  try { raise InvalidPassword => 'foo'; }
  catch {
    my ($e) = @_;
    $e->does('InvalidLogin', 'InvalidPassword') # true
    ...
  };
=head2 get_composition
Returns the composed types of an exception. As every exception inherits of
Dancer::Exception::Base, the returned list contains at least 'Base', and the
exception class name.
B<Warning>, the result is a list, so you should call this method in list context.
  try { raise InvalidPassword => 'foo'; }
  catch {
    my ($e) = @_;
    my @list = $e->get_composition()
    # @list contains ( 'InvalidPassword', 'Base', ... )
  };
=head2 message
Computes and returns the message associated to the exception. It'll apply the
parameters that were set at throw time to the message pattern of the exception.
=head1 STRINGIFICATION
=head2 string overloading
All Dancer exceptions properly stringify. When evaluated to a string, they
return their message, concatenated with their stack trace (see below).
=head2 cmp overloading
The C<cmp> operator is also overloaded, thus all the string operations can be
done on Dancer's exceptions, as they will all be based on the overloaded C<cmp>
operator. Dancer exceptions will be compared B<without> their stacktraces.
=head1 STACKTRACE
Similarly to L<Carp>, Dancer exceptions stringification appends a string
stacktrace to the exception message.
The stacktrace can be a short one, or a long one. Actually the implementation
internally uses L<Carp>.
To enable long stack trace (for debugging purpose), you can use the global
variable C<Dancer::Exception::Verbose> (see below).
The short and long stacktrace snippets are stored within C<$self->{_shortmess}>
and C<$self->{_longmess}>. Don't touch them or rely on them, they are
internals, and will change soon.
=head1 GLOBAL VARIABLE
=head2 $Dancer::Exception::Verbose
When set to 1, exceptions will stringify with a long stack trace. This variable
is similar to C<$Carp::Verbose>. I recommend you use it like that:
  local $Dancer::Exception::Verbose;
  $Dancer::Exception::Verbose = 1;
All the L<Carp> global variables can also be used to alter the stacktrace
generation.
=head1 AUTHOR
Dancer Core Developers
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2010 by Alexis Sukrieh.
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