File Coverage

blib/lib/WebAPI/DBIC/Resource/Role/DBICException.pm
Criterion Covered Total %
statement 15 46 32.6
branch 0 16 0.0
condition 0 5 0.0
subroutine 5 7 71.4
pod 0 2 0.0
total 20 76 26.3


line stmt bran cond sub pod time code
1             package WebAPI::DBIC::Resource::Role::DBICException;
2             $WebAPI::DBIC::Resource::Role::DBICException::VERSION = '0.003002';
3              
4 2     2   19362773 use Carp qw(croak confess);
  2         28  
  2         402  
5 2     2   18 use Scalar::Util qw(blessed);
  2         8  
  2         379  
6 2     2   1198 use Devel::Dwarn;
  2         21112  
  2         16  
7 2     2   1383 use JSON::MaybeXS qw(JSON);
  2         1367  
  2         183  
8              
9 2     2   1150 use Moo::Role;
  2         47314  
  2         15  
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.003002
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