File Coverage

blib/lib/Whelk/Wrapper.pm
Criterion Covered Total %
statement 105 119 88.2
branch 30 38 78.9
condition 8 12 66.6
subroutine 25 28 89.2
pod 9 12 75.0
total 177 209 84.6


line stmt bran cond sub pod time code
1             package Whelk::Wrapper;
2             $Whelk::Wrapper::VERSION = '1.04';
3 20     20   13675 use Kelp::Base;
  20         40  
  20         139  
4              
5 20     20   5287 use Try::Tiny;
  20         47  
  20         1610  
6 20     20   155 use Scalar::Util qw(blessed);
  20         34  
  20         1312  
7 20     20   1270 use HTTP::Status qw(status_message);
  20         13067  
  20         1427  
8 20     20   2764 use Kelp::Exception;
  20         7135  
  20         190  
9 20     20   792 use Whelk::Schema;
  20         39  
  20         515  
10 20     20   3290 use Whelk::Exception;
  20         47  
  20         174  
11              
12             sub inhale_request
13             {
14 78     78 1 199 my ($self, $app, $endpoint, @args) = @_;
15 78         299 my $req = $app->req;
16 78         1102 my $inhaled;
17              
18 78         300 my $params = $endpoint->parameters;
19              
20 78 100       633 if ($params->path_schema) {
21             $params->path_schema->inhale_or_error(
22             $req->named,
23             sub {
24 2     2   27 Whelk::Exception->throw(422, hint => "Path parameters error at: $_[0]");
25             }
26 11         104 );
27             }
28              
29 76 100       673 if ($params->query_schema) {
30             my $new_query = $params->query_schema->inhale_exhale(
31             $req->query_parameters->mixed,
32             sub {
33 5     5   62 Whelk::Exception->throw(422, hint => "Query parameters error at: $_[0]");
34             }
35 17         153 );
36              
37             # adjust the parameters in the request itself to allow all calls of
38             # ->param and ->query_param to just work
39 12         81 $req->query_parameters->clear->merge_mixed($new_query);
40 12         703 $req->parameters->clear->merge_mixed($new_query)->merge_mixed($req->body_parameters->mixed);
41             }
42              
43 71 100       9668 if ($params->header_schema) {
44 16         109 my %headers;
45 16         78 foreach my $key ($req->headers->header_field_names) {
46 67         5126 my @values = map { split /, /, $_ } $req->header($key);
  67         2340  
47 67 100       277 $headers{$key} = @values == 1 ? $values[0] : \@values;
48             }
49              
50             $params->header_schema->inhale_or_error(
51             \%headers,
52             sub {
53 5     5   74 Whelk::Exception->throw(422, hint => "Header parameters error at: $_[0]");
54             }
55 16         130 );
56             }
57              
58 66 100       506 if ($params->cookie_schema) {
59             $params->cookie_schema->inhale_or_error(
60             $req->cookies,
61             sub {
62 3     3   26 Whelk::Exception->throw(422, hint => "Cookie parameters error at: $_[0]");
63             }
64 11         58 );
65             }
66              
67 63 100       508 if ($endpoint->request) {
68             $req->stash->{request} = $endpoint->request->inhale_exhale(
69             $endpoint->formatter->get_request_body($app),
70             sub {
71 8     8   111 Whelk::Exception->throw(422, hint => "Content error at: $_[0]");
72             }
73 20         169 );
74             }
75             }
76              
77             sub exhale_response
78             {
79 83     83 1 286 my ($self, $app, $endpoint, $response, $inhale_error) = @_;
80 83         231 my $code = $app->res->code;
81 83         1517 my $schema = $self->map_code_to_schema($endpoint, $code);
82 83         331 my $path = $endpoint->path;
83              
84 83 100 66     959 if ($schema && $schema->empty) {
85 1 50       3 if ($self->_get_code_class($code) ne '2XX') {
86 0 0       0 die "gave up trying to find a non-empty schema for $path"
87             if $code == 500;
88              
89 0         0 $app->res->set_code(500);
90 0         0 my $error = $self->on_error($app, "empty schema for non-success code in $path (code $code)");
91 0         0 return $self->exhale_response($app, $endpoint, $error);
92             }
93             }
94             else {
95 82         304 $response = $self->wrap_response($response, $code);
96             }
97              
98 83 50       280 if (!$schema) {
99              
100             # make sure not to loop if code is already 500
101 0 0       0 Kelp::Exception->throw(508, body => "gave up trying to find a schema for $path")
102             if $code == 500;
103              
104 0         0 $app->res->set_code(500);
105 0         0 my $error = $self->on_error($app, "no data schema for $path (code $code)");
106 0         0 return $self->exhale_response($app, $endpoint, $error);
107             }
108              
109             # try inhaling
110 83 50       513 if ($app->whelk->inhale_response) {
111 83         1246 my $inhaled = $schema->inhale($response);
112 83 100       303 if (defined $inhaled) {
113              
114             # If this is an error with inhaling itself, we have to resort to
115             # throwing an exception to avoid an infinite recursion. This may
116             # happen if the wrapper code has a bug in wrap_error and
117             # build_response_schemas.
118 7 100       58 die "gave up trying to inhale error response for $path: $inhaled"
119             if $inhale_error;
120              
121             # otherwise, we can exhale_response again, this time with an error
122 6         44 $app->res->set_code(500);
123 6         219 my $error = $self->on_error($app, "response schema validation failed for $path: $inhaled");
124 6         227 return $self->exhale_response($app, $endpoint, $error, 1);
125             }
126             }
127              
128 76         394 return $schema->exhale($response);
129             }
130              
131             sub execute
132             {
133 78     78 1 243 my ($self, $app, $endpoint, @args) = @_;
134              
135 78         164 my ($success, $data);
136             try {
137 78     78   3775 $self->inhale_request($app, $endpoint);
138 53         612 $data = $endpoint->code->($app->context->current, @args);
139 48         3462 $success = 1;
140             }
141             catch {
142 30     30   1830 $data = $_;
143 30         129 $success = 0;
144 78         732 };
145              
146 78         1411 return ($success, $data);
147             }
148              
149             sub prepare_response
150             {
151 78     78 1 230 my ($self, $app, $endpoint, $success, $data) = @_;
152 78         302 my $res = $app->res;
153              
154             # decide on the resulting code and data based on status
155 78 100       1131 if ($success) {
156 48 100       238 $res->set_code($endpoint->response_code) unless $res->code;
157             }
158             else {
159 30 100 66     297 if (blessed $data && $data->isa('Kelp::Exception')) {
160              
161             # Whelk exceptions are API exceptions and will yield API responses if
162             # possible. Kelp exceptions are application exceptions and will yield a
163             # regular error page.
164 29 100       135 $data->throw unless $data->isa('Whelk::Exception');
165 28         127 $res->set_code($data->code);
166 28   66     891 $data = $data->hint // $self->on_error($app, $data->body);
167             }
168             else {
169 1         4 $res->set_code(500);
170 1         14 $data = $self->on_error($app, $data);
171             }
172             }
173              
174 77         1859 return $self->exhale_response($app, $endpoint, $data);
175             }
176              
177             sub _get_code_class
178             {
179 121     121   266 my ($self, $code) = @_;
180              
181 121         307 substr $code, 1, 2, 'XX';
182 121         434 return $code;
183             }
184              
185             sub map_code_to_schema
186             {
187 83     83 1 270 my ($self, $endpoint, $code) = @_;
188              
189 83         319 my $schemas = $endpoint->response_schemas;
190 83   66     751 return $schemas->{$code} // $schemas->{$self->_get_code_class($code)};
191             }
192              
193             sub wrap_response
194             {
195 82     82 1 215 my ($self, $data, $code) = @_;
196 82         200 state $map = {
197             '2XX' => 'success',
198             '4XX' => 'client_error',
199             '5XX' => 'server_error',
200             };
201              
202 82         226 my $code_class = $self->_get_code_class($code);
203 82         239 my $method = "wrap_$map->{$code_class}";
204              
205 82         467 return $self->$method($data);
206             }
207              
208             sub on_error
209             {
210 10     10 1 106 my ($self, $app, $data) = @_;
211              
212 10 50       97 $app->logger(error => $data)
213             if $app->can('logger');
214              
215 10         4975 return status_message($app->res->code);
216             }
217              
218             sub wrap
219             {
220 115     115 1 953 my ($self, $endpoint) = @_;
221 115         452 $self->build_response_schemas($endpoint);
222              
223             return sub {
224 78     78   199352 my $app = shift->context->app;
225              
226 78         1286 my $prepared = $self->prepare_response(
227             $app,
228             $endpoint,
229             $self->execute($app, $endpoint, @_),
230             );
231              
232 76         693 return $endpoint->formatter->format_response($app, $prepared);
233 115         1024 };
234             }
235              
236             sub wrap_server_error
237             {
238 0     0 0 0 my ($self, $error) = @_;
239              
240 0         0 ...;
241             }
242              
243             sub wrap_client_error
244             {
245 29     29 0 83 my ($self, $error) = @_;
246              
247 29         131 return $self->wrap_server_error($error);
248             }
249              
250             sub wrap_success
251             {
252 0     0 0   my ($self, $data) = @_;
253              
254 0           ...;
255             }
256              
257             sub build_response_schemas
258             {
259 0     0 1   my ($self, $endpoint) = @_;
260              
261 0           ...;
262             }
263              
264             1;
265              
266             __END__
267              
268             =pod
269              
270             =head1 NAME
271              
272             Whelk::Wrapper - Base class for wrappers
273              
274             =head1 SYNOPSIS
275              
276             package Whelk::Wrapper::MyWrapper;
277              
278             use Kelp::Base 'Whelk::Wrapper';
279              
280             # at the very least, there three methods must be implemented
281              
282             sub wrap_server_error
283             {
284             my ($self, $error) = @_;
285              
286             ...;
287             }
288              
289             sub wrap_success
290             {
291             my ($self, $data) = @_;
292              
293             ...;
294             }
295              
296             sub build_response_schemas
297             {
298             my ($self, $endpoint) = @_;
299              
300             ...;
301             }
302              
303             =head1 DESCRIPTION
304              
305             Whelk::Wrapper is a base class for wrappers. Wrapper's job is to wrap the
306             endpoint handler in necessary logic: validating request and response data,
307             adding extra data to responses and error handling. Wrappers do not handle
308             encoding requests and responses (for example with C<JSON>), that's a job for
309             L<Whelk::Formatter>.
310              
311             In addition, wrapper decides how to treat failures. It defines schemas for
312             errors with status classes 4XX and 5XX and uses those instead of response
313             schema defined for the endpoint in case an error occurs.
314              
315             Whelk implements two basic wrappers which can be used out of the box:
316             L<Whelk::Wrapper::Simple> (the default) and L<Whelk::Wrapper::WithStatus>. They
317             are very similar and differ in how they wrap the response data - C<WithStatus>
318             wrapper introduces an extra boolean C<status> field to every response.
319              
320             It should be pretty easy to subclass a wrapper if needed. Take a look at the
321             built in subclasses and at the code of this class to get the basic idea.
322              
323             =head1 METHODS
324              
325             The only wrapper method called from outside is C<wrap>. All the other methods
326             are helpers which make it easier to adjust the behavior without rewriting it
327             from scratch.
328              
329             The base C<Whelk::Wrapper> class does not implement C<wrap_server_error>,
330             C<wrap_success> and C<build_response_schemas> methods - they have to be
331             implemented in a subclass.
332              
333             =head2 wrap
334              
335             my $wrapped_sub = $wrapper->wrap($sub);
336              
337             Takes a reference to a subroutine and returns a reference to another
338             subroutine. The returned subroutine is an outer code to be called by Kelp as
339             route handler. It does all the Whelk-specific behavior and calls the inner
340             subroutine to get the actual result of the API call.
341              
342             =head2 wrap_response
343              
344             my $response = $wrapper->wrap_response($response, $http_code);
345              
346             This method is used to wrap C<$response> returned by Kelp route handler. The
347             default implementation takes a look at the C<$http_code> and fires one of
348             C<wrap_success> (for codes 2XX), C<wrap_server_error> (for codes 5XX) or
349             C<wrap_client_error> (for codes 4XX). The wrapped response must be matching the
350             respone schema defined in L</build_response_schemas> or else an exception will
351             be thrown.
352              
353             =head2 build_response_schemas
354              
355             $wrapper->build_response_schemas($endpoint)
356              
357             Takes an object of L<Whelk::Endpoint> class and should set C<response_schemas>
358             field of that object. That field must contain a hash reference where each key
359             will be response code and each value will be a schema built using
360             L<Whelk::Schema/build>. Regular success schema should nest the value of C<<
361             $endpoint->response >> schema inside of it.
362              
363             The status codes need not to be exact. By default, only their class is
364             important (C<2XX>, C<4XX> or C<5XX>). The exact semantics of that mapping is
365             defined in another method, L</map_code_to_schema>.
366              
367             If the schema from C<< $endpoint->response >> is empty via C<<
368             $endpoint->response->empty >> then it must be added to C<response_schemas> as
369             is to correctly be mapped to C<204 No Body> HTTP status.
370              
371             =head2 inhale_request
372              
373             This is a helper method which validates the request. It may be overridden for
374             extra behavior.
375              
376             To ensure C<request_body> method works, it must set C<<
377             $app->req->stash->{request} >> after validating and cleaning the request body.
378              
379             =head2 execute
380              
381             This is a helper method which runs the actual route handler in a try/catch
382             block. It may be overridden for extra behavior.
383              
384             =head2 prepare_response
385              
386             This is a helper method which prepares a response to be passed to
387             L</exhale_response>. It may be overridden for extra behavior.
388              
389             =head2 exhale_response
390              
391             This is a helper method which validates and returns a response. It may be
392             overridden for extra behavior.
393              
394             =head2 map_code_to_schema
395              
396             This is a helper method which decides which key from C<response_schemas> of the
397             endpoint to use based on HTTP code of the response. It may be overridden for
398             extra behavior.
399              
400             =head2 on_error
401              
402             This is a helper method which decides what to do when an unexpected error
403             occurs. By default, it creates an application log and modifies the result
404             message to return a stock HTTP message like C<Internal Server Error>. It may be
405             overridden for extra behavior.
406