Bug 17600: Standardize our EXPORT_OK
[srvgit] / Koha / REST / Plugin / Query.pm
1 package Koha::REST::Plugin::Query;
2
3 # This file is part of Koha.
4 #
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
9 #
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18 use Modern::Perl;
19
20 use Mojo::Base 'Mojolicious::Plugin';
21 use List::MoreUtils qw( any );
22 use Scalar::Util qw( reftype );
23 use JSON qw( decode_json );
24
25 use Koha::Exceptions;
26
27 =head1 NAME
28
29 Koha::REST::Plugin::Query
30
31 =head1 API
32
33 =head2 Mojolicious::Plugin methods
34
35 =head3 register
36
37 =cut
38
39 sub register {
40     my ( $self, $app ) = @_;
41
42 =head2 Helper methods
43
44 =head3 extract_reserved_params
45
46     my ( $filtered_params, $reserved_params ) = $c->extract_reserved_params($params);
47
48 Generates the DBIC query from the query parameters.
49
50 =cut
51
52     $app->helper(
53         'extract_reserved_params' => sub {
54             my ( $c, $params ) = @_;
55
56             my $reserved_params;
57             my $filtered_params;
58             my $path_params;
59
60             my $reserved_words = _reserved_words();
61             my @query_param_names = keys %{$c->req->params->to_hash};
62
63             foreach my $param ( keys %{$params} ) {
64                 if ( grep { $param eq $_ } @{$reserved_words} ) {
65                     $reserved_params->{$param} = $params->{$param};
66                 }
67                 elsif ( grep { $param eq $_ } @query_param_names ) {
68                     $filtered_params->{$param} = $params->{$param};
69                 }
70                 else {
71                     $path_params->{$param} = $params->{$param};
72                 }
73             }
74
75             return ( $filtered_params, $reserved_params, $path_params );
76         }
77     );
78
79 =head3 dbic_merge_sorting
80
81     $attributes = $c->dbic_merge_sorting({ attributes => $attributes, params => $params });
82
83 Generates the DBIC order_by attributes based on I<$params>, and merges into I<$attributes>.
84
85 =cut
86
87     $app->helper(
88         'dbic_merge_sorting' => sub {
89             my ( $c, $args ) = @_;
90             my $attributes = $args->{attributes};
91             my $result_set = $args->{result_set};
92
93             my @order_by_styles = (
94                 '_order_by',
95                 '_order_by[]'
96             );
97             my @order_by_params;
98
99             foreach my $order_by_style ( @order_by_styles ) {
100                 if ( defined $args->{params}->{$order_by_style} and ref($args->{params}->{$order_by_style}) eq 'ARRAY' )  {
101                     push( @order_by_params, @{$args->{params}->{$order_by_style} });
102                 }
103                 else {
104                     push @order_by_params, $args->{params}->{$order_by_style}
105                         if defined $args->{params}->{$order_by_style};
106                 }
107             }
108
109             my @THE_order_by;
110
111             foreach my $order_by_param ( @order_by_params ) {
112                 my $order_by;
113                 $order_by = [ split(/,/, $order_by_param) ]
114                     if ( !reftype($order_by_param) && index(',',$order_by_param) == -1);
115
116                 if ($order_by) {
117                     if ( reftype($order_by) and reftype($order_by) eq 'ARRAY' ) {
118                         my @order_by = map { _build_order_atom({ string => $_, result_set => $result_set }) } @{ $order_by };
119                         push( @THE_order_by, @order_by);
120                     }
121                     else {
122                         push @THE_order_by, _build_order_atom({ string => $order_by, result_set => $result_set });
123                     }
124                 }
125             }
126
127             $attributes->{order_by} = \@THE_order_by
128                 if scalar @THE_order_by > 0;
129
130             return $attributes;
131         }
132     );
133
134 =head3 dbic_merge_prefetch
135
136     $attributes = $c->dbic_merge_prefetch({ attributes => $attributes, result_set => $result_set });
137
138 Generates the DBIC prefetch attribute based on embedded relations, and merges into I<$attributes>.
139
140 =cut
141
142     $app->helper(
143         'dbic_merge_prefetch' => sub {
144             my ( $c, $args ) = @_;
145             my $attributes = $args->{attributes};
146             my $result_set = $args->{result_set};
147             my $embed = $c->stash('koha.embed');
148
149             return unless defined $embed;
150
151             my @prefetches;
152             foreach my $key (sort keys(%{$embed})) {
153                 my $parsed = _parse_prefetch($key, $embed, $result_set);
154                 push @prefetches, $parsed if defined $parsed;
155             }
156
157             if(scalar(@prefetches)) {
158                 $attributes->{prefetch} = \@prefetches;
159             }
160         }
161     );
162
163 =head3 _build_query_params_from_api
164
165     my $params = _build_query_params_from_api( $filtered_params, $reserved_params );
166
167 Builds the params for searching on DBIC based on the selected matching algorithm.
168 Valid options are I<contains>, I<starts_with>, I<ends_with> and I<exact>. Default is
169 I<contains>. If other value is passed, a Koha::Exceptions::WrongParameter exception
170 is raised.
171
172 =cut
173
174     $app->helper(
175         'build_query_params' => sub {
176
177             my ( $c, $filtered_params, $reserved_params ) = @_;
178
179             my $params;
180             my $match = $reserved_params->{_match} // 'contains';
181
182             foreach my $param ( keys %{$filtered_params} ) {
183                 if ( $match eq 'contains' ) {
184                     $params->{$param} =
185                       { like => '%' . $filtered_params->{$param} . '%' };
186                 }
187                 elsif ( $match eq 'starts_with' ) {
188                     $params->{$param} = { like => $filtered_params->{$param} . '%' };
189                 }
190                 elsif ( $match eq 'ends_with' ) {
191                     $params->{$param} = { like => '%' . $filtered_params->{$param} };
192                 }
193                 elsif ( $match eq 'exact' ) {
194                     $params->{$param} = $filtered_params->{$param};
195                 }
196                 else {
197                     # We should never reach here, because the OpenAPI plugin should
198                     # prevent invalid params to be passed
199                     Koha::Exceptions::WrongParameter->throw(
200                         "Invalid value for _match param ($match)");
201                 }
202             }
203
204             return $params;
205         }
206     );
207
208 =head3 merge_q_params
209
210     $c->merge_q_params( $filtered_params, $q_params, $result_set );
211
212 Merges parameters from $q_params into $filtered_params.
213
214 =cut
215
216     $app->helper(
217         'merge_q_params' => sub {
218
219             my ( $c, $filtered_params, $q_params, $result_set ) = @_;
220
221             $q_params = decode_json($q_params) unless reftype $q_params;
222
223             my $params = _parse_dbic_query($q_params, $result_set);
224
225             return $params unless scalar(keys %{$filtered_params});
226             return {'-and' => [$params, $filtered_params ]};
227         }
228     );
229
230 =head3 stash_embed
231
232     $c->stash_embed( $c->match->endpoint->pattern->defaults->{'openapi.op_spec'} );
233
234 =cut
235
236     $app->helper(
237         'stash_embed' => sub {
238
239             my ( $c, $args ) = @_;
240
241             my $spec = $args->{spec} // {};
242
243             my $embed_spec   = $spec->{'x-koha-embed'};
244             my $embed_header = $c->req->headers->header('x-koha-embed');
245
246             Koha::Exceptions::BadParameter->throw("Embedding objects is not allowed on this endpoint.")
247                 if $embed_header and !defined $embed_spec;
248
249             if ( $embed_header ) {
250                 my $THE_embed = {};
251                 foreach my $embed_req ( split /\s*,\s*/, $embed_header ) {
252                     my $matches = grep {lc $_ eq lc $embed_req} @{ $embed_spec };
253
254                     Koha::Exceptions::BadParameter->throw(
255                         error => 'Embeding '.$embed_req. ' is not authorised. Check your x-koha-embed headers or remove it.'
256                     ) unless $matches;
257
258                     _merge_embed( _parse_embed($embed_req), $THE_embed);
259                 }
260
261                 $c->stash( 'koha.embed' => $THE_embed )
262                     if $THE_embed;
263             }
264
265             return $c;
266         }
267     );
268
269 =head3 stash_overrides
270
271     # Stash the overrides
272     $c->stash_overrides();
273     #Use it
274     my $overrides = $c->stash('koha.overrides');
275     if ( $overrides->{pickup_location} ) { ... }
276
277 This helper method parses 'x-koha-override' headers and stashes the passed overriders
278 in the for of a I<hashref> for easy use in controller methods.
279
280 FIXME: With the currently used JSON::Validator version we use, it is not possible to
281 use the validated and coerced data (it doesn't validate array-type headers) so this
282 implementation relies on manual parsing. Look at the JSON::Validator changelog for
283 reference: https://metacpan.org/changes/distribution/JSON-Validator#L14
284
285 =cut
286
287     $app->helper(
288         'stash_overrides' => sub {
289
290             my ( $c ) = @_;
291
292             my $override_header = $c->req->headers->header('x-koha-override') || q{};
293
294             my $overrides = { map { $_ => 1 } split /\s*,\s*/, $override_header };
295
296             $c->stash( 'koha.overrides' => $overrides );
297
298             return $c;
299         }
300     );
301 }
302
303 =head2 Internal methods
304
305 =head3 _reserved_words
306
307     my $reserved_words = _reserved_words();
308
309 =cut
310
311 sub _reserved_words {
312
313     my @reserved_words = qw( _match _order_by _order_by[] _page _per_page q query x-koha-query);
314     return \@reserved_words;
315 }
316
317 =head3 _build_order_atom
318
319     my $order_atom = _build_order_atom( $string );
320
321 Parses I<$string> and outputs data valid for using in SQL::Abstract order_by attribute
322 according to the following rules:
323
324      string -> I<string>
325     +string -> I<{ -asc => string }>
326     -string -> I<{ -desc => string }>
327
328 =cut
329
330 sub _build_order_atom {
331     my ( $args )   = @_;
332     my $string     = $args->{string};
333     my $result_set = $args->{result_set};
334
335     my $param = $string;
336     $param =~ s/^(\+|\-|\s)//;
337     if ( $result_set ) {
338         my $model_param = _from_api_param($param, $result_set);
339         $param = $model_param if defined $model_param;
340     }
341
342     if ( $string =~ m/^\+/ or
343          $string =~ m/^\s/ ) {
344         # asc order operator present
345         return { -asc => $param };
346     }
347     elsif ( $string =~ m/^\-/ ) {
348         # desc order operator present
349         return { -desc => $param };
350     }
351     else {
352         # no order operator present
353         return $param;
354     }
355 }
356
357 =head3 _parse_embed
358
359     my $embed = _parse_embed( $string );
360
361 Parses I<$string> and outputs data valid for passing to the Kohaa::Object(s)->to_api
362 method.
363
364 =cut
365
366 sub _parse_embed {
367     my $string = shift;
368
369     my $result;
370     my ( $curr, $next ) = split /\s*\.\s*/, $string, 2;
371
372     if ( $next ) {
373         $result->{$curr} = { children => _parse_embed( $next ) };
374     }
375     else {
376         if ( $curr =~ m/^(?<relation>.*)\+count/ ) {
377             my $key = $+{relation} . "_count";
378             $result->{$key} = { is_count => 1 };
379         }
380         else {
381             $result->{$curr} = {};
382         }
383     }
384
385     return $result;
386 }
387
388 =head3 _merge_embed
389
390     _merge_embed( $parsed_embed, $global_embed );
391
392 Merges the hash referenced by I<$parsed_embed> into I<$global_embed>.
393
394 =cut
395
396 sub _merge_embed {
397     my ( $structure, $embed ) = @_;
398
399     my ($root) = keys %{ $structure };
400
401     if ( any { $root eq $_ } keys %{ $embed } ) {
402         # Recurse
403         _merge_embed( $structure->{$root}, $embed->{$root} );
404     }
405     else {
406         # Embed
407         $embed->{$root} = $structure->{$root};
408     }
409 }
410
411 sub _parse_prefetch {
412     my ( $key, $embed, $result_set) = @_;
413
414     my $pref_key = $key;
415     $pref_key =~ s/_count$// if $embed->{$key}->{is_count};
416     return unless exists $result_set->prefetch_whitelist->{$pref_key};
417
418     my $ko_class = $result_set->prefetch_whitelist->{$pref_key};
419     return $pref_key unless defined $embed->{$key}->{children} && defined $ko_class;
420
421     my @prefetches;
422     foreach my $child (sort keys(%{$embed->{$key}->{children}})) {
423         my $parsed = _parse_prefetch($child, $embed->{$key}->{children}, $ko_class->new);
424         push @prefetches, $parsed if defined $parsed;
425     }
426
427     return $pref_key unless scalar(@prefetches);
428
429     return {$pref_key => $prefetches[0]} if scalar(@prefetches) eq 1;
430
431     return {$pref_key => \@prefetches};
432 }
433
434 sub _from_api_param {
435     my ($key, $result_set) = @_;
436
437     if($key =~ /\./) {
438
439         my ($curr, $next) = split /\s*\.\s*/, $key, 2;
440
441         return $curr.'.'._from_api_param($next, $result_set) if $curr eq 'me';
442
443         my $ko_class = $result_set->prefetch_whitelist->{$curr};
444
445         Koha::Exceptions::BadParameter->throw("Cannot find Koha::Object class for $curr")
446             unless defined $ko_class;
447
448         $result_set = $ko_class->new;
449
450         if ($next =~ /\./) {
451             return _from_api_param($next, $result_set);
452         } else {
453             return $curr.'.'.($result_set->from_api_mapping && defined $result_set->from_api_mapping->{$next} ? $result_set->from_api_mapping->{$next}:$next);
454         }
455     } else {
456         return defined $result_set->from_api_mapping->{$key} ? $result_set->from_api_mapping->{$key} : $key;
457     }
458 }
459
460 sub _parse_dbic_query {
461     my ($q_params, $result_set) = @_;
462
463     if(reftype($q_params) && reftype($q_params) eq 'HASH') {
464         my $parsed_hash;
465         foreach my $key (keys %{$q_params}) {
466             if($key =~ /-?(not_?)?bool/i ) {
467                 $parsed_hash->{$key} = _from_api_param($q_params->{$key}, $result_set);
468                 next;
469             }
470             my $k = _from_api_param($key, $result_set);
471             $parsed_hash->{$k} = _parse_dbic_query($q_params->{$key}, $result_set);
472         }
473         return $parsed_hash;
474     } elsif (reftype($q_params) && reftype($q_params) eq 'ARRAY') {
475         my @mapped = map{ _parse_dbic_query($_, $result_set) } @$q_params;
476         return \@mapped;
477     } else {
478         return $q_params;
479     }
480
481 }
482
483 1;