-
Notifications
You must be signed in to change notification settings - Fork 576
/
Exception.pm
374 lines (263 loc) · 9.58 KB
/
Exception.pm
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
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
package Mojo::Exception;
use Mojo::Base -base;
use overload bool => sub {1}, '""' => sub { shift->to_string }, fallback => 1;
use Carp qw(croak);
use Exporter qw(import);
use Mojo::Util qw(decode);
use Scalar::Util qw(blessed);
has [qw(frames line lines_after lines_before)] => sub { [] };
has message => 'Exception!';
has verbose => sub { $ENV{MOJO_EXCEPTION_VERBOSE} };
our @EXPORT_OK = qw(check raise);
sub check {
my ($err, $spec) = @_;
return undef unless $err;
croak "Array reference of pattern/handler pairs required to dispatch exceptions"
if ref $spec ne 'ARRAY' || @$spec % 2;
my ($default, $handler);
my ($is_obj, $str) = (!!blessed($err), "$err");
CHECK: for (my $i = 0; $i < @$spec; $i += 2) {
my ($checks, $cb) = @{$spec}[$i, $i + 1];
($default = $cb) and next if $checks eq 'default';
for my $c (ref $checks eq 'ARRAY' ? @$checks : $checks) {
my $is_re = !!ref $c;
($handler = $cb) and last CHECK if $is_obj && !$is_re && $err->isa($c);
($handler = $cb) and last CHECK if $is_re && $str =~ $c;
}
}
# Rethrow if no handler could be found
die $err unless $handler ||= $default;
$handler->($_) for $err;
return 1;
}
sub inspect {
my ($self, @sources) = @_;
return $self if @{$self->line};
# Extract file and line from message
my @files;
my $msg = $self->message;
unshift @files, [$1, $2] while $msg =~ /at\s+(.+?)\s+line\s+(\d+)/g;
# Extract file and line from stack trace
if (my $zero = $self->frames->[0]) { push @files, [$zero->[1], $zero->[2]] }
# Search for context in files
for my $file (@files) {
next unless -r $file->[0] && open my $handle, '<', $file->[0];
$self->_context($file->[1], [[<$handle>]]);
return $self;
}
# Search for context in sources
$self->_context($files[-1][1], [map { [split /\n/] } @sources]) if @sources;
return $self;
}
sub new { defined $_[1] ? shift->SUPER::new(message => shift) : shift->SUPER::new }
sub raise {
my ($class, $err) = @_ > 1 ? (@_) : (__PACKAGE__, shift);
if (!$class->can('new')) { die $@ unless eval "package $class; use Mojo::Base 'Mojo::Exception'; 1" }
elsif (!$class->isa(__PACKAGE__)) { die "$class is not a Mojo::Exception subclass" }
CORE::die $class->new($err)->trace;
}
sub to_string {
my $self = shift;
my $str = $self->message;
my $frames = $self->frames;
if ($str !~ /\n$/) {
$str .= @$frames ? " at $frames->[0][1] line $frames->[0][2].\n" : "\n";
}
return $str unless $self->verbose;
my $line = $self->line;
if (@$line) {
$str .= "Context:\n";
$str .= " $_->[0]: $_->[1]\n" for @{$self->lines_before};
$str .= " $line->[0]: $line->[1]\n";
$str .= " $_->[0]: $_->[1]\n" for @{$self->lines_after};
}
if (my $max = @$frames) {
$str .= "Traceback (most recent call first):\n";
$str .= qq{ File "$_->[1]", line $_->[2], in "$_->[3]"\n} for @$frames;
}
return $str;
}
sub throw { CORE::die shift->new(shift)->trace }
sub trace {
my ($self, $start) = (shift, shift // 1);
my @frames;
while (my @trace = caller($start++)) { push @frames, \@trace }
return $self->frames(\@frames);
}
sub _append {
my ($stack, $line) = @_;
$line = decode('UTF-8', $line) // $line;
chomp $line;
push @$stack, $line;
}
sub _context {
my ($self, $num, $sources) = @_;
# Line
return unless defined $sources->[0][$num - 1];
$self->line([$num]);
_append($self->line, $_->[$num - 1]) for @$sources;
# Before
for my $i (2 .. 6) {
last if ((my $previous = $num - $i) < 0);
unshift @{$self->lines_before}, [$previous + 1];
_append($self->lines_before->[0], $_->[$previous]) for @$sources;
}
# After
for my $i (0 .. 4) {
next if ((my $next = $num + $i) < 0);
next unless defined $sources->[0][$next];
push @{$self->lines_after}, [$next + 1];
_append($self->lines_after->[-1], $_->[$next]) for @$sources;
}
}
1;
=encoding utf8
=head1 NAME
Mojo::Exception - Exception base class
=head1 SYNOPSIS
# Create exception classes
package MyApp::X::Foo {
use Mojo::Base 'Mojo::Exception';
}
package MyApp::X::Bar {
use Mojo::Base 'Mojo::Exception';
}
# Throw exceptions and handle them gracefully
use Mojo::Exception qw(check);
eval {
MyApp::X::Foo->throw('Something went wrong!');
};
check $@ => [
'MyApp::X::Foo' => sub { say "Foo: $_" },
'MyApp::X::Bar' => sub { say "Bar: $_" }
];
# Generate exception classes on demand
use Mojo::Exception qw(check raise);
eval {
raise 'MyApp::X::Name', 'The name Minion is already taken';
};
check $@ => [
'MyApp::X::Name' => sub { say "Name error: $_" },
default => sub { say "Error: $_" }
];
=head1 DESCRIPTION
L<Mojo::Exception> is a container for exceptions with context information.
=head1 FUNCTIONS
L<Mojo::Exception> implements the following functions, which can be imported individually.
=head2 check
my $bool = check $err => ['MyApp::X::Foo' => sub {...}];
Process exceptions by dispatching them to handlers with one or more matching conditions. Exceptions that could not be
handled will be rethrown automatically. Note that this function is B<EXPERIMENTAL> and might change without warning!
# Handle various types of exceptions
eval {
dangerous_code();
};
check $@ => [
'MyApp::X::Foo' => sub { say "Foo: $_" },
qr/^Could not open/ => sub { say "Open error: $_" },
default => sub { say "Something went wrong: $_" }
];
Matching conditions can be class names for ISA checks on exception objects, or regular expressions to match string
exceptions and stringified exception objects. The matching exception will be the first argument passed to the callback,
and is also available as C<$_>.
# Catch MyApp::X::Foo object or a specific string exception
eval {
dangerous_code();
};
check $@ => [
'MyApp::X::Foo' => sub { say "Foo: $_" },
qr/^Could not open/ => sub { say "Open error: $_" }
];
An array reference can be used to share the same handler with multiple conditions, of which only one needs to match.
And since exception handlers are just callbacks, they can also throw their own exceptions.
# Handle MyApp::X::Foo and MyApp::X::Bar the same
eval {
dangerous_code();
};
check $@ => [
['MyApp::X::Foo', 'MyApp::X::Bar'] => sub { die "Foo/Bar: $_" }
];
There is currently only one keywords you can use to set special handlers. The C<default> handler is used when no other
handler matched.
# Use "default" to catch everything
eval {
dangerous_code();
};
check $@ => [
default => sub { say "Error: $_" }
];
=head2 raise
raise 'Something went wrong!';
raise 'MyApp::X::Foo', 'Something went wrong!';
Raise a L<Mojo::Exception>, if the class does not exist yet (classes are checked for a C<new> method), one is created
as a L<Mojo::Exception> subclass on demand. Note that this function is B<EXPERIMENTAL> and might change without
warning!
=head1 ATTRIBUTES
L<Mojo::Exception> implements the following attributes.
=head2 frames
my $frames = $e->frames;
$e = $e->frames([$frame1, $frame2]);
Stack trace if available.
# Extract information from the last frame
my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext,
$is_require, $hints, $bitmask, $hinthash) = @{$e->frames->[-1]};
=head2 line
my $line = $e->line;
$e = $e->line([3, 'die;']);
The line where the exception occurred if available.
=head2 lines_after
my $lines = $e->lines_after;
$e = $e->lines_after([[4, 'say $foo;'], [5, 'say $bar;']]);
Lines after the line where the exception occurred if available.
=head2 lines_before
my $lines = $e->lines_before;
$e = $e->lines_before([[1, 'my $foo = 23;'], [2, 'my $bar = 24;']]);
Lines before the line where the exception occurred if available.
=head2 message
my $msg = $e->message;
$e = $e->message('Died at test.pl line 3.');
Exception message, defaults to C<Exception!>.
=head2 verbose
my $bool = $e->verbose;
$e = $e->verbose($bool);
Show more information with L</"to_string">, such as L</"frames">, defaults to the value of the
C<MOJO_EXCEPTION_VERBOSE> environment variable.
=head1 METHODS
L<Mojo::Exception> inherits all methods from L<Mojo::Base> and implements the following new ones.
=head2 inspect
$e = $e->inspect;
$e = $e->inspect($source1, $source2);
Inspect L</"message">, L</"frames"> and optional additional sources to fill L</"lines_before">, L</"line"> and
L</"lines_after"> with context information.
=head2 new
my $e = Mojo::Exception->new;
my $e = Mojo::Exception->new('Died at test.pl line 3.');
Construct a new L<Mojo::Exception> object and assign L</"message"> if necessary.
=head2 to_string
my $str = $e->to_string;
Render exception. Note that the output format may change as more features are added, only the error message at the
beginning is guaranteed not to be modified to allow regex matching.
=head2 throw
Mojo::Exception->throw('Something went wrong!');
Throw exception from the current execution context.
# Longer version
die Mojo::Exception->new('Something went wrong!')->trace;
=head2 trace
$e = $e->trace;
$e = $e->trace($skip);
Generate stack trace and store all L</"frames">, defaults to skipping C<1> call frame.
# Skip 3 call frames
$e->trace(3);
# Skip no call frames
$e->trace(0);
=head1 OPERATORS
L<Mojo::Exception> overloads the following operators.
=head2 bool
my $bool = !!$e;
Always true.
=head2 stringify
my $str = "$e";
Alias for L</"to_string">.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
=cut