'bool'
=>
sub
{1},
'""'
=>
sub
{
shift
->to_string },
fallback
=> 1;
has
[
qw/frames line lines_before lines_after/
] =>
sub
{ [] };
has
[
qw/message raw_message/
] =>
'Exception!'
;
has
verbose
=>
sub
{
$ENV
{MOJO_EXCEPTION_VERBOSE} || 0 };
sub
new {
my
$self
=
shift
->SUPER::new;
return
@_
?
$self
->_detect(
@_
) :
$self
;
}
sub
throw {
die
shift
->new->trace(2)->_detect(
@_
) }
sub
to_string {
my
$self
=
shift
;
return
$self
->message
unless
$self
->verbose;
my
$string
=
''
;
$string
.=
$self
->message
if
$self
->message;
$string
.=
$_
->[0] .
': '
.
$_
->[1] .
"\n"
for
@{
$self
->lines_before};
$string
.= (
$self
->line->[0] .
': '
.
$self
->line->[1] .
"\n"
)
if
$self
->line->[0];
$string
.=
$_
->[0] .
': '
.
$_
->[1] .
"\n"
for
@{
$self
->lines_after};
return
$string
;
}
sub
trace {
my
(
$self
,
$start
) =
@_
;
$start
//= 1;
my
@frames
;
while
(
my
@trace
=
caller
(
$start
++)) {
push
@frames
, \
@trace
}
$self
->frames(\
@frames
);
return
$self
;
}
sub
_detect {
my
$self
=
shift
;
my
$message
=
shift
;
return
$message
if
blessed
$message
&&
$message
->isa(
'Mojo::Exception'
);
$self
->message(
$message
)->raw_message(
$message
);
my
@trace
;
while
(
$message
=~ /at\s+(.+?)\s+line\s+(\d+)/g) {
push
@trace
, [$1, $2] }
if
(
my
$first
=
$self
->frames->[0]) {
unshift
@trace
, [
$first
->[1],
$first
->[2]]
if
$first
->[1];
}
foreach
my
$frame
(
reverse
@trace
) {
next
unless
-r
$frame
->[0];
my
$handle
= IO::File->new(
$frame
->[0],
'<:utf8'
);
$self
->_parse_context(
$frame
->[1], [[<
$handle
>]]);
return
$self
;
}
return
$self
unless
my
$files
=
shift
;
my
@lines
=
map
{ [
split
/\n/] }
@$files
;
return
$self
unless
my
$name
=
shift
;
unless
(
ref
$message
) {
my
$filter
=
sub
{
my
$num
=
shift
;
my
$new
=
"$name line $num"
;
my
$line
=
$lines
[0]->[
$num
];
$new
.=
qq/, near "$line"/
if
defined
$line
;
return
$new
.=
'.'
;
};
$message
=~ s/\(
eval
\s+\d+\) line (\d+).*/
$filter
->($1)/ge;
$self
->message(
$message
);
}
$name
=
quotemeta
$name
;
my
$line
;
if
(
$self
->message =~ /at\s+
$name
\s+line\s+(\d+)/) {
$line
= $1 }
else
{
for
my
$frame
(@{
$self
->frames}) {
next
unless
$frame
->[1] =~ /^\(
eval
\ \d+\)$/;
$line
=
$frame
->[2];
last
;
}
}
$self
->_parse_context(
$line
, \
@lines
)
if
$line
;
return
$self
;
}
sub
_parse_context {
my
(
$self
,
$line
,
$lines
) =
@_
;
return
unless
defined
$lines
->[0]->[
$line
- 1];
$self
->line([
$line
]);
for
my
$l
(
@$lines
) {
chomp
(
my
$code
=
$l
->[
$line
- 1]);
push
@{
$self
->line},
$code
;
}
for
my
$i
(2 .. 6) {
last
if
((
my
$previous
=
$line
-
$i
) < 0);
if
(
defined
(
$lines
->[0]->[
$previous
])) {
unshift
@{
$self
->lines_before}, [
$previous
+ 1];
for
my
$l
(
@$lines
) {
chomp
(
my
$code
=
$l
->[
$previous
]);
push
@{
$self
->lines_before->[0]},
$code
;
}
}
}
for
my
$i
(0 .. 4) {
next
if
((
my
$next
=
$line
+
$i
) < 0);
if
(
defined
(
$lines
->[0]->[
$next
])) {
push
@{
$self
->lines_after}, [
$next
+ 1];
for
my
$l
(
@$lines
) {
next
unless
defined
(
my
$code
=
$l
->[
$next
]);
chomp
$code
;
push
@{
$self
->lines_after->[-1]},
$code
;
}
}
}
return
$self
;
}
1;