Bug 24191: Add to_model param to _build_order_atom and dbic_merge_sorting

This patch adds a to_model parameter to dbic_merge_sorting so it is
passed when used (for example from objects.search). The to_model param
is passed along to the _build_order_atom method where it is finally
used.

In the process I wrote tests that reflected some problems in the current
code:
- Mojolicious automatically returns a scalar if a query parameter only
happens once on a request. The code expected an arrayref in every case.
- There's a design issue that forced me to use some hacky code in
_build_order_atom.

The first issue is dealth with, by using Scalar::Util::reftype as the
Perl docs recommend.

The second issue, I don't plan to clean it here, as there's ongoing work
on a Koha::Objects->search_from_api method that will obsolete this code
most probably (see bug 23893 for a better picture of where the mappings
will be living soon).

To test:
1. Apply this patch
2. Run:
  $ kshell
 k$ prove t/Koha/REST/Plugin/Query.t
=> SUCCESS: Tests pass!!
3. Sign off :-D

Sponsored-by: ByWater Solutions
Signed-off-by: Owen Leonard <oleonard@myacpl.org>
Signed-off-by: Josef Moravec <josef.moravec@gmail.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Koha/REST/Plugin/Query.pm

@@ -18,6 +18,7 @@ package Koha::REST::Plugin::Query;
 use Modern::Perl;
 
 use Mojo::Base 'Mojolicious::Plugin';
+use Scalar::Util qw(reftype);
 
 use Koha::Exceptions;
 
@@ -80,11 +81,18 @@ Generates the DBIC order_by attributes based on I<$params>, and merges into I<$a
         'dbic_merge_sorting' => sub {
             my ( $c, $args ) = @_;
             my $attributes = $args->{attributes};
+            my $to_model   = $args->{to_model};
 
             if ( defined $args->{params}->{_order_by} ) {
-                my @order_by = map { _build_order_atom($_) }
-                               @{ $args->{params}->{_order_by} };
-                $attributes->{order_by} = \@order_by;
+                my $order_by = $args->{params}->{_order_by};
+                if ( reftype($order_by) and reftype($order_by) eq 'ARRAY' ) {
+                    my @order_by = map { _build_order_atom( $_, $to_model) }
+                                @{ $args->{params}->{_order_by} };
+                    $attributes->{order_by} = \@order_by;
+                }
+                else {
+                    $attributes->{order_by} = _build_order_atom( $order_by, $to_model );
+                }
             }
 
             return $attributes;
@@ -166,21 +174,27 @@ according to the following rules:
 
 sub _build_order_atom {
     my $string = shift;
+    my $to_model = shift;
+
+    # FIXME: This should be done differently once 23893 is pushed
+    #        and we have access to the to_model_mapping hash
+    my $param = $string;
+    $param =~ s/^(\+|\-|\s)//;
+    $param = (keys %{$to_model->({ $param => 1 })})[0]
+        if $to_model;
 
     if ( $string =~ m/^\+/ or
          $string =~ m/^\s/ ) {
         # asc order operator present
-        $string =~ s/^(\+|\s)//;
-        return { -asc => $string };
+        return { -asc => $param };
     }
     elsif ( $string =~ m/^\-/ ) {
         # desc order operator present
-        $string =~ s/^\-//;
-        return { -desc => $string };
+        return { -desc => $param };
     }
     else {
         # no order operator present
-        return $string;
+        return $param;
     }
 }
 

t/Koha/REST/Plugin/Query.t

@@ -80,6 +80,31 @@ get '/dbic_merge_sorting' => sub {
     $c->render( json => $attributes, status => 200 );
 };
 
+get '/dbic_merge_sorting_single' => sub {
+    my $c = shift;
+    my $attributes = { a => 'a', b => 'b' };
+    $attributes = $c->dbic_merge_sorting(
+        {
+            attributes => $attributes,
+            params     => { _match => 'exact', _order_by => '-uno' }
+        }
+    );
+    $c->render( json => $attributes, status => 200 );
+};
+
+get '/dbic_merge_sorting_to_model' => sub {
+    my $c = shift;
+    my $attributes = { a => 'a', b => 'b' };
+    $attributes = $c->dbic_merge_sorting(
+        {
+            attributes => $attributes,
+            params     => { _match => 'exact', _order_by => [ 'uno', '-dos', '+tres', ' cuatro' ] },
+            to_model   => \&to_model
+        }
+    );
+    $c->render( json => $attributes, status => 200 );
+};
+
 get '/build_query' => sub {
     my $c = shift;
     my ( $filtered_params, $reserved_params ) =
@@ -97,6 +122,13 @@ get '/build_query' => sub {
     };
 };
 
+sub to_model {
+    my ($args) = @_;
+    $args->{three} = delete $args->{tres}
+        if exists $args->{tres};
+    return $args;
+}
+
 # The tests
 
 use Test::More tests => 3;
@@ -131,7 +163,7 @@ subtest 'extract_reserved_params() tests' => sub {
 
 subtest 'dbic_merge_sorting() tests' => sub {
 
-    plan tests => 5;
+    plan tests => 15;
 
     my $t = Test::Mojo->new;
 
@@ -145,6 +177,23 @@ subtest 'dbic_merge_sorting() tests' => sub {
             { -asc  => 'cuatro' }
         ]
       );
+
+    $t->get_ok('/dbic_merge_sorting_to_model')->status_is(200)
+      ->json_is( '/a' => 'a', 'Existing values are kept (a)' )
+      ->json_is( '/b' => 'b', 'Existing values are kept (b)' )->json_is(
+        '/order_by' => [
+            'uno',
+            { -desc => 'dos' },
+            { -asc  => 'three' },
+            { -asc  => 'cuatro' }
+        ]
+      );
+
+    $t->get_ok('/dbic_merge_sorting_single')->status_is(200)
+      ->json_is( '/a' => 'a', 'Existing values are kept (a)' )
+      ->json_is( '/b' => 'b', 'Existing values are kept (b)' )->json_is(
+        '/order_by' => { '-desc' => 'uno' }
+      );
 };
 
 subtest '_build_query_params_from_api' => sub {