line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WebAPI::DBIC::Resource::Role::DBICException; |
2
|
|
|
|
|
|
|
$WebAPI::DBIC::Resource::Role::DBICException::VERSION = '0.004001'; |
3
|
|
|
|
|
|
|
|
4
|
2
|
|
|
2
|
|
30666077
|
use Carp qw(croak confess); |
|
2
|
|
|
|
|
14
|
|
|
2
|
|
|
|
|
362
|
|
5
|
2
|
|
|
2
|
|
14
|
use Scalar::Util qw(blessed); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
397
|
|
6
|
2
|
|
|
2
|
|
1084
|
use Devel::Dwarn; |
|
2
|
|
|
|
|
20249
|
|
|
2
|
|
|
|
|
16
|
|
7
|
2
|
|
|
2
|
|
1345
|
use JSON::MaybeXS qw(JSON); |
|
2
|
|
|
|
|
1436
|
|
|
2
|
|
|
|
|
144
|
|
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
950
|
use Moo::Role; |
|
2
|
|
|
|
|
42981
|
|
|
2
|
|
|
|
|
18
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
requires 'response'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub finish_request { |
16
|
0
|
|
|
0
|
0
|
|
my ($self, $metadata) = @_; |
17
|
|
|
|
|
|
|
|
18
|
0
|
|
|
|
|
|
return $self->handle_web_machine_exception($metadata->{exception}); |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# XXX we probably ought to allow a stck/list of handlers that can try to |
23
|
|
|
|
|
|
|
# recognise an exception - we'd try them in turn, perhaps until one has |
24
|
|
|
|
|
|
|
# converted it into an object that has an as_psgi method. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub handle_web_machine_exception { |
27
|
0
|
|
|
0
|
0
|
|
my ($self, $exception) = @_; |
28
|
|
|
|
|
|
|
|
29
|
0
|
0
|
|
|
|
|
return unless $exception; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
#warn "$exception"; |
32
|
|
|
|
|
|
|
|
33
|
0
|
0
|
0
|
|
|
|
if (blessed($exception) && $exception->can('as_psgi')) { |
34
|
0
|
|
|
|
|
|
my ($status, $headers, $body) = @{ $exception->as_psgi }; |
|
0
|
|
|
|
|
|
|
35
|
0
|
|
|
|
|
|
$self->response->status($status); |
36
|
0
|
|
|
|
|
|
$self->response->headers($headers); |
37
|
0
|
|
|
|
|
|
$self->response->body($body); |
38
|
0
|
|
|
|
|
|
return; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
#$exception->rethrow if ref $exception and $exception->can('rethrow'); |
42
|
|
|
|
|
|
|
#die $exception if ref $exception; |
43
|
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
(my $line1 = $exception) =~ s/\n.*//ms; |
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
my $error_data; |
47
|
|
|
|
|
|
|
# ... DBD::Pg::st execute failed: ERROR: column "nonesuch" does not exist |
48
|
0
|
0
|
|
|
|
|
if ($exception =~ m/DBD::.*? \s+ failed:.*? \s+ column:? \s+ "?(.*?)"? \s+ (.*)/x) { |
|
|
0
|
|
|
|
|
|
49
|
0
|
|
|
|
|
|
$error_data = { |
50
|
|
|
|
|
|
|
status => 400, |
51
|
|
|
|
|
|
|
field => $1, |
52
|
|
|
|
|
|
|
foo => "$1: $2", |
53
|
|
|
|
|
|
|
}; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
# handle exceptions from Params::Validate |
56
|
|
|
|
|
|
|
elsif ($exception =~ /The \s '(\w+)' \s parameter \s \(.*?\) \s to \s (\S+) \s did \s not \s pass/x) { |
57
|
0
|
|
|
|
|
|
$error_data = { |
58
|
|
|
|
|
|
|
status => 400, |
59
|
|
|
|
|
|
|
field => $1, |
60
|
|
|
|
|
|
|
message => $line1, |
61
|
|
|
|
|
|
|
}; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
0
|
0
|
|
|
|
|
warn "Exception: $line1 (@{[ %{ $error_data||{} } ]})\n" |
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
if $ENV{WEBAPI_DBIC_DEBUG}; |
66
|
|
|
|
|
|
|
|
67
|
0
|
0
|
|
|
|
|
if ($error_data) { # we recognized the exception |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
0
|
|
|
|
$error_data->{status} ||= 500; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# only include detailed exception information if not in production |
72
|
|
|
|
|
|
|
# (as it might contain sensitive information) |
73
|
0
|
0
|
|
|
|
|
$error_data->{_embedded}{exceptions}[0]{exception} = "$exception" # stringify |
74
|
|
|
|
|
|
|
if $ENV{PLACK_ENV} ne 'production'; |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# create response |
77
|
|
|
|
|
|
|
# XXX would be nice to create an exception object that can as_psgi() |
78
|
|
|
|
|
|
|
# then reuse the handling of that above |
79
|
|
|
|
|
|
|
# XXX would also be good to adopt a more formal error structure, such as |
80
|
|
|
|
|
|
|
# application/vnd.error+json => https://github.com/blongden/vnd.error |
81
|
0
|
|
|
|
|
|
my $json = JSON->new->ascii->pretty; |
82
|
0
|
|
|
|
|
|
my $response = $self->response; |
83
|
0
|
|
|
|
|
|
$response->status($error_data->{status}); |
84
|
0
|
|
|
|
|
|
my $body = $json->encode($error_data); |
85
|
0
|
|
|
|
|
|
$response->body($body); |
86
|
0
|
|
|
|
|
|
$response->content_length(length $body); |
87
|
0
|
|
|
|
|
|
$response->content_type('application/json'); |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
else { |
90
|
0
|
|
|
|
|
|
warn "Exception: $line1\n" |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
0
|
|
|
|
|
|
return; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
1; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
__END__ |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=pod |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=encoding UTF-8 |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head1 NAME |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
WebAPI::DBIC::Resource::Role::DBICException |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 VERSION |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
version 0.004001 |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head1 NAME |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
WebAPI::DBIC::Resource::Role::DBICException - methods for handling exceptions from resources |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=head1 AUTHOR |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
Tim Bunce <Tim.Bunce@pobox.com> |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
This software is copyright (c) 2015 by Tim Bunce. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
126
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=cut |