/usr/share/perl5/Dancer/Exception/Base.pm is in libdancer-perl 1.3202+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 | package Dancer::Exception::Base;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: the base class of all Dancer exceptions
$Dancer::Exception::Base::VERSION = '1.3202';
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__
=pod
=encoding UTF-8
=head1 NAME
Dancer::Exception::Base - the base class of all Dancer exceptions
=head1 VERSION
version 1.3202
=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
|