Added support for tweaking where to store response in stash
[catagits/Catalyst-Controller-DBIC-API.git] / lib / Catalyst / Controller / DBIC / API.pm
index 422dc54..2a72e28 100644 (file)
@@ -2,7 +2,7 @@ package Catalyst::Controller::DBIC::API;
 
 #ABSTRACT: Provides a DBIx::Class web service automagically
 use Moose;
-BEGIN { extends 'Catalyst::Controller'; }
+BEGIN { extends 'Catalyst::Controller::ActionRole'; }
 
 use CGI::Expand ();
 use DBIx::Class::ResultClass::HashRefInflator;
@@ -15,9 +15,9 @@ use Try::Tiny;
 use Catalyst::Controller::DBIC::API::Request;
 use namespace::autoclean;
 
-with 'Catalyst::Controller::DBIC::API::StoredResultSource';
-with 'Catalyst::Controller::DBIC::API::StaticArguments';
-with 'Catalyst::Controller::DBIC::API::RequestArguments' => { static => 1 };
+with 'Catalyst::Controller::DBIC::API::StoredResultSource',
+     'Catalyst::Controller::DBIC::API::StaticArguments',
+     'Catalyst::Controller::DBIC::API::RequestArguments' => { static => 1 };
 
 __PACKAGE__->config();
 
@@ -29,24 +29,25 @@ __PACKAGE__->config();
 
   __PACKAGE__->config
     ( action => { setup => { PathPart => 'artist', Chained => '/api/rpc/rpc_base' } }, # define parent chain action and partpath
-      class => 'MyAppDB::Artist', # DBIC schema class
-      create_requires => ['name', 'age'], # columns required to create
-      create_allows => ['nickname'], # additional non-required columns that create allows
-      update_allows => ['name', 'age', 'nickname'], # columns that update allows
-      update_allows => ['name', 'age', 'nickname'], # columns that update allows
-      select => [qw/name age/], # columns that data returns
-      prefetch => ['cds'], # relationships that are prefetched when no prefetch param is passed
-      prefetch_allows => [ # every possible prefetch param allowed
+      class            => 'MyAppDB::Artist',
+      result_class     => 'MyAppDB::ResultSet::Artist',
+      create_requires  => ['name', 'age'],
+      create_allows    => ['nickname'],
+      update_allows    => ['name', 'age', 'nickname'],
+      update_allows    => ['name', 'age', 'nickname'],
+      select           => [qw/name age/],
+      prefetch         => ['cds'],
+      prefetch_allows  => [
           'cds',
           qw/ cds /,
           { cds => 'tracks' },
-          { cds => [qw/ tracks /] }
+          { cds => [qw/ tracks /] },
       ],
-      ordered_by => [qw/age/], # order of generated list
-      search_exposes => [qw/age nickname/, { cds => [qw/title year/] }], # columns that can be searched on via list
-      data_root => 'data' # defaults to "list" for backwards compatibility
-      use_json_boolean => 1, # use JSON::Any::true|false in the response instead of strings
-      return_object => 1, # makes create and update actions return the object
+      ordered_by       => [qw/age/],
+      search_exposes   => [qw/age nickname/, { cds => [qw/title year/] }],
+      data_root        => 'data',
+      use_json_boolean => 1,
+      return_object    => 1,
       );
 
   # Provides the following functional endpoints:
@@ -72,7 +73,6 @@ sub begin :Private
         unless Moose::Util::does_role($c->req, 'Catalyst::Controller::DBIC::API::Request');
 }
 
-
 =method_protected setup
 
  :Chained('specify.in.subclass.config') :CaptureArgs(0) :PathPart('specify.in.subclass.config')
@@ -80,11 +80,11 @@ sub begin :Private
 This action is the chain root of the controller. It must either be overridden or configured to provide a base pathpart to the action and also a parent action. For example, for class MyAppDB::Track you might have
 
   package MyApp::Controller::API::RPC::Track;
-  use Moose; 
+  use Moose;
   BEGIN { extends 'Catalyst::Controller::DBIC::API::RPC'; }
 
   __PACKAGE__->config
-    ( action => { setup => { PathPart => 'track', Chained => '/api/rpc/rpc_base' } }, 
+    ( action => { setup => { PathPart => 'track', Chained => '/api/rpc/rpc_base' } },
        ...
   );
 
@@ -128,7 +128,7 @@ sub deserialize :Chained('setup') :CaptureArgs(0) :PathPart('') :ActionClass('De
     {
         $req_params = $c->req->data;
     }
-    else 
+    else
     {
         $req_params = CGI::Expand->expand_hash($c->req->params);
 
@@ -148,7 +148,7 @@ sub deserialize :Chained('setup') :CaptureArgs(0) :PathPart('') :ActionClass('De
                         $req_params->{$param}->{$key} = $deserialized;
                     }
                     catch
-                    { 
+                    {
                         $c->log->debug("Param '$param.$key' did not deserialize appropriately: $_")
                         if $c->debug;
                     }
@@ -162,14 +162,14 @@ sub deserialize :Chained('setup') :CaptureArgs(0) :PathPart('') :ActionClass('De
                     $req_params->{$param} = $deserialized;
                 }
                 catch
-                { 
+                {
                     $c->log->debug("Param '$param' did not deserialize appropriately: $_")
                     if $c->debug;
                 }
             }
         }
     }
-    
+
     $self->inflate_request($c, $req_params);
 }
 
@@ -181,13 +181,14 @@ generate_rs is used by inflate_request to generate the resultset stored in the c
 
 sub generate_rs
 {
-    my ($self, $c) = @_;
+    #my ($self, $c) = @_;
+    my ($self) = @_;
+
     return $self->stored_result_source->resultset;
 }
 
-
 =method_protected inflate_request
+
 inflate_request is called at the end of deserialize to populate key portions of the request with the useful bits
 
 =cut
@@ -199,14 +200,14 @@ sub inflate_request
     try
     {
         # set static arguments
-        $c->req->_set_controller($self); 
+        $c->req->_set_controller($self);
 
         # set request arguments
         $c->req->_set_request_data($params);
 
         # set the current resultset
         $c->req->_set_current_result_set($self->generate_rs($c));
-        
+
     }
     catch
     {
@@ -259,12 +260,12 @@ This action is the chain root for object level actions (such as create, update,
 sub objects_no_id :Chained('deserialize') :CaptureArgs(0) :PathPart('')
 {
     my ($self, $c) = @_;
-    
+
     if($c->req->has_request_data)
     {
         my $data = $c->req->request_data;
         my $vals;
-        
+
         if(exists($data->{$self->data_root}) && defined($data->{$self->data_root}))
         {
             my $root = $data->{$self->data_root};
@@ -329,11 +330,9 @@ sub object_lookup
 
 =method_protected list
 
- :Private
-
-List level action chained from L</setup>. List's steps are broken up into three distinct methods: L</list_munge_parameters>, L</list_perform_search>, and L</list_format_output>.
+list's steps are broken up into three distinct methods: L</list_munge_parameters>, L</list_perform_search>, and L</list_format_output>.
 
-The goal of this method is to call ->search() on the current_result_set, HashRefInflator the result, and return it in $c->stash->{response}->{$self->data_root}. Please see the individual methods for more details on what actual processing takes place.
+The goal of this method is to call ->search() on the current_result_set, change resultset class of the result (if needed), and return it in $c->stash->{$self->stash_key}->{$self->data_root}. Please see the individual methods for more details on what actual processing takes place.
 
 If the L</select> config param is defined then the hashes will contain only those columns, otherwise all columns in the object will be returned. L</select> of course supports the function/procedure calling semantics that L<DBIx::Class::ResultSet/select>. In order to have proper column names in the result, provide arguments in L</as> (which also follows L<DBIx::Class::ResultSet/as> semantics. Similarly L</count>, L</page>, L</grouped_by> and L</ordered_by> affect the maximum number of rows returned as well as the ordering and grouping. Note that if select, count, ordered_by or grouped_by request parameters are present then these will override the values set on the class with select becoming bound by the select_exposes attribute.
 
@@ -358,12 +357,12 @@ Note that if pagination is needed, this can be achieved using a combination of t
   ?page=2&count=20
 
 Would result in this search:
+
  $rs->search({}, { page => 2, rows => 20 })
 
 =cut
 
-sub list :Private 
+sub list
 {
     my ($self, $c) = @_;
 
@@ -372,12 +371,13 @@ sub list :Private
     $self->list_format_output($c);
 
     # make sure there are no objects lingering
-    $c->req->clear_objects(); 
+    $c->req->clear_objects();
 }
 
 =method_protected list_munge_parameters
 
 list_munge_parameters is a noop by default. All arguments will be passed through without any manipulation. In order to successfully manipulate the parameters before the search is performed, simply access $c->req->search_parameters|search_attributes (ArrayRef and HashRef respectively), which correspond directly to ->search($parameters, $attributes). Parameter keys will be in already-aliased form.
+To store the munged parameters call $c->req->_set_search_parameters($newparams) and $c->req->_set_search_attributes($newattrs).
 
 =cut
 
@@ -392,14 +392,14 @@ list_perform_search executes the actual search. current_result_set is updated to
 sub list_perform_search
 {
     my ($self, $c) = @_;
-    
-    try 
+
+    try
     {
         my $req = $c->req;
-        
+
         my $rs = $req->current_result_set->search
         (
-            $req->search_parameters, 
+            $req->search_parameters,
             $req->search_attributes
         );
 
@@ -427,18 +427,18 @@ sub list_format_output
     my ($self, $c) = @_;
 
     my $rs = $c->req->current_result_set->search;
-    $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
-    
+    $rs->result_class($self->result_class) if $self->result_class;
+
     try
     {
         my $output = {};
         my $formatted = [];
-        
+
         foreach my $row ($rs->all)
         {
             push(@$formatted, $self->row_format_output($c, $row));
         }
-        
+
         $output->{$self->data_root} = $formatted;
 
         if ($c->req->has_search_total_entries)
@@ -446,7 +446,7 @@ sub list_format_output
             $output->{$self->total_entries_arg} = $c->req->search_total_entries + 0;
         }
 
-        $c->stash->{response} = $output;
+        $c->stash->{$self->stash_key} = $output;
     }
     catch
     {
@@ -464,19 +464,18 @@ row_format_output is called each row of the inflated output generated from the s
 
 sub row_format_output
 {
-    my ($self, $c, $row) = @_;
+    #my ($self, $c, $row) = @_;
+    my ($self, undef, $row) = @_;
     return $row; # passthrough by default
 }
 
 =method_protected item
- :Private
 
 item will return a single object called by identifier in the uri. It will be inflated via each_object_inflate.
 
 =cut
 
-sub item :Private 
+sub item
 {
     my ($self, $c) = @_;
 
@@ -488,23 +487,20 @@ sub item :Private
     }
     else
     {
-        $c->stash->{response}->{$self->item_root} = $self->each_object_inflate($c, $c->req->get_object(0)->[0]);
+        $c->stash->{$self->stash_key}->{$self->item_root} = $self->each_object_inflate($c, $c->req->get_object(0)->[0]);
     }
 }
 
-
 =method_protected update_or_create
 
- :Private
-
 update_or_create is responsible for iterating any stored objects and performing updates or creates. Each object is first validated to ensure it meets the criteria specified in the L</create_requires> and L</create_allows> (or L</update_allows>) parameters of the controller config. The objects are then committed within a transaction via L</transact_objects> using a closure around L</save_objects>.
 
 =cut
 
-sub update_or_create :Private
+sub update_or_create
 {
     my ($self, $c) = @_;
-    
+
     if($c->req->has_objects)
     {
         $self->validate_objects($c);
@@ -527,7 +523,7 @@ transact_objects performs the actual commit to the database via $schema->txn_do.
 sub transact_objects
 {
     my ($self, $c, $coderef) = @_;
-    
+
     try
     {
         $self->stored_result_source->schema->txn_do
@@ -565,7 +561,7 @@ sub validate_objects
     {
         my $err = $_;
         $c->log->error($err);
-        $err =~ s/\s+at\s+\/.+\n$//g;
+        $err =~ s/\s+at\s+.+\n$//g;
         $self->push_error($c, { message => $err });
         $c->detach();
     }
@@ -586,22 +582,22 @@ sub validate_object
     my %requires_map = map
     {
         $_ => 1
-    } 
+    }
     @{
-        ($object->in_storage) 
-        ? [] 
+        ($object->in_storage)
+        ? []
         : $c->stash->{create_requires} || $self->create_requires
     };
-    
+
     my %allows_map = map
     {
         (ref $_) ? %{$_} : ($_ => 1)
-    } 
+    }
     (
-        keys %requires_map, 
+        keys %requires_map,
         @{
-            ($object->in_storage) 
-            ? ($c->stash->{update_allows} || $self->update_allows) 
+            ($object->in_storage)
+            ? ($c->stash->{update_allows} || $self->update_allows)
             : ($c->stash->{create_allows} || $self->create_allows)
         }
     );
@@ -610,22 +606,22 @@ sub validate_object
     {
         # check value defined if key required
         my $allowed_fields = $allows_map{$key};
-        
+
         if (ref $allowed_fields)
         {
             my $related_source = $object->result_source->related_source($key);
             my $related_params = $params->{$key};
             my %allowed_related_map = map { $_ => 1 } @$allowed_fields;
             my $allowed_related_cols = ($allowed_related_map{'*'}) ? [$related_source->columns] : $allowed_fields;
-            
+
             foreach my $related_col (@{$allowed_related_cols})
             {
-                if (my $related_col_value = $related_params->{$related_col}) {
+                if (defined(my $related_col_value = $related_params->{$related_col})) {
                     $values{$key}{$related_col} = $related_col_value;
                 }
             }
         }
-        else 
+        else
         {
             my $value = $params->{$key};
 
@@ -641,9 +637,9 @@ sub validate_object
                     }
                 }
             }
-            
+
             # check for multiple values
-            if (ref($value) && !($value == JSON::Any::true || $value == JSON::Any::false))
+            if (ref($value) && !(reftype($value) eq reftype(JSON::Any::true)))
             {
                 require Data::Dumper;
                 die "Multiple values for '${key}': ${\Data::Dumper::Dumper($value)}";
@@ -655,26 +651,24 @@ sub validate_object
         }
     }
 
-    unless (keys %values || !$object->in_storage) 
+    unless (keys %values || !$object->in_storage)
     {
         die 'No valid keys passed';
     }
 
-    return \%values;  
+    return \%values;
 }
 
 =method_protected delete
 
- :Private
-
 delete operates on the stored objects in the request. It first transacts the objects, deleting them in the database using L</transact_objects> and a closure around L</delete_objects>, and then clears the request store of objects.
 
 =cut
 
-sub delete :Private
+sub delete
 {
     my ($self, $c) = @_;
-    
+
     if($c->req->has_objects)
     {
         $self->transact_objects($c, sub { $self->delete_objects($c, @_) });
@@ -720,7 +714,7 @@ sub save_object
     {
         $self->update_object_from_params($c, $object, $params);
     }
-    else 
+    else
     {
         $self->insert_object_from_params($c, $object, $params);
     }
@@ -729,7 +723,7 @@ sub save_object
 
 =method_protected update_object_from_params
 
-update_object_from_params iterates through the params to see if any of them are pertinent to relations. If so it calls L</update_object_relation> with the object, and the relation parameters. Then it calls ->upbdate on the object.
+update_object_from_params iterates through the params to see if any of them are pertinent to relations. If so it calls L</update_object_relation> with the object, and the relation parameters. Then it calls ->update on the object.
 
 =cut
 
@@ -740,13 +734,22 @@ sub update_object_from_params
     foreach my $key (keys %$params)
     {
         my $value = $params->{$key};
-        if (ref($value) && !($value == JSON::Any::true || $value == JSON::Any::false))
+        if (ref($value) && !(reftype($value) eq reftype(JSON::Any::true)))
         {
             $self->update_object_relation($c, $object, delete $params->{$key}, $key);
         }
+        # accessor = colname
+        elsif ($object->can($key)) {
+            $object->$key($value);
+        }
+        # accessor != colname
+        else {
+            my $accessor = $object->result_source->column_info($key)->{accessor};
+            $object->$accessor($value);
+        }
     }
-    
-    $object->update($params);
+
+    $object->update();
 }
 
 =method_protected update_object_relation
@@ -759,7 +762,29 @@ sub update_object_relation
 {
     my ($self, $c, $object, $related_params, $relation) = @_;
     my $row = $object->find_related($relation, {} , {});
-    $row->update($related_params);
+
+    if ($row) {
+        foreach my $key (keys %$related_params) {
+            my $value = $related_params->{$key};
+            if (ref($value) && !(reftype($value) eq reftype(JSON::Any::true)))
+            {
+                $self->update_object_relation($c, $row, delete $related_params->{$key}, $key);
+            }
+            # accessor = colname
+            elsif ($row->can($key)) {
+                $row->$key($value);
+            }
+            # accessor != colname
+            else {
+                my $accessor = $row->result_source->column_info($key)->{accessor};
+                $row->$accessor($value);
+            }
+        }
+        $row->update();
+    }
+    else {
+        $object->create_related($relation, $related_params);
+    }
 }
 
 =method_protected insert_object_from_params
@@ -770,9 +795,24 @@ insert_object_from_params sets the columns for the object, then calls ->insert
 
 sub insert_object_from_params
 {
-    my ($self, $c, $object, $params) = @_;
-    $object->set_columns($params);
+    #my ($self, $c, $object, $params) = @_;
+    my ($self, undef, $object, $params) = @_;
+
+    my %rels;
+    while (my ($k, $v) = each %{ $params }) {
+        if (ref($v) && !(reftype($v) eq reftype(JSON::Any::true))) {
+            $rels{$k} = $v;
+        }
+        else {
+            $object->set_column($k => $v);
+        }
+    }
+
     $object->insert;
+
+    while (my ($k, $v) = each %rels) {
+        $object->create_related($k, $v);
+    }
 }
 
 =method_protected delete_objects
@@ -796,20 +836,19 @@ Performs the actual ->delete on the object
 
 sub delete_object
 {
-    my ($self, $c, $object) = @_;
+    #my ($self, $c, $object) = @_;
+    my ($self, undef, $object) = @_;
 
     $object->delete;
 }
 
 =method_protected end
 
- :Private
-
 end performs the final manipulation of the response before it is serialized. This includes setting the success of the request both at the HTTP layer and JSON layer. If configured with return_object true, and there are stored objects as the result of create or update, those will be inflated according to the schema and get_inflated_columns
 
 =cut
 
-sub end :Private 
+sub end :Private
 {
     my ($self, $c) = @_;
 
@@ -819,25 +858,25 @@ sub end :Private
     # Check for errors caught elsewhere
     if ( $c->res->status and $c->res->status != 200 ) {
         $default_status = $c->res->status;
-        $c->stash->{response}->{success} = $self->use_json_boolean ? JSON::Any::false : 'false';
+        $c->stash->{$self->stash_key}->{success} = $self->use_json_boolean ? JSON::Any::false : 'false';
     } elsif ($self->get_errors($c)) {
-        $c->stash->{response}->{messages} = $self->get_errors($c);
-        $c->stash->{response}->{success} = $self->use_json_boolean ? JSON::Any::false : 'false';
+        $c->stash->{$self->stash_key}->{messages} = $self->get_errors($c);
+        $c->stash->{$self->stash_key}->{success} = $self->use_json_boolean ? JSON::Any::false : 'false';
         $default_status = 400;
     } else {
-        $c->stash->{response}->{success} = $self->use_json_boolean ? JSON::Any::true : 'true';
+        $c->stash->{$self->stash_key}->{success} = $self->use_json_boolean ? JSON::Any::true : 'true';
         $default_status = 200;
     }
-    
+
     unless ($default_status == 200)
     {
-        delete $c->stash->{response}->{$self->data_root};
+        delete $c->stash->{$self->stash_key}->{$self->data_root};
     }
     elsif($self->return_object && $c->req->has_objects)
     {
         my $returned_objects = [];
         push(@$returned_objects, $self->each_object_inflate($c, $_)) for map { $_->[0] } $c->req->all_objects;
-        $c->stash->{response}->{$self->data_root} = scalar(@$returned_objects) > 1 ? $returned_objects : $returned_objects->[0];
+        $c->stash->{$self->stash_key}->{$self->data_root} = scalar(@$returned_objects) > 1 ? $returned_objects : $returned_objects->[0];
     }
 
     $c->res->status( $default_status || 200 );
@@ -854,11 +893,18 @@ This only executes if L</return_object> if set and if there are any objects to a
 
 sub each_object_inflate
 {
-    my ($self, $c, $object) = @_;
+    #my ($self, $c, $object) = @_;
+    my ($self, undef, $object) = @_;
 
-    return { $object->get_inflated_columns };
+    return { $object->get_columns };
 }
 
+=method_protected serialize
+
+multiple actions forward to serialize which uses Catalyst::Action::Serialize.
+
+=cut
+
 # from Catalyst::Action::Serialize
 sub serialize :ActionClass('Serialize') { }
 
@@ -871,7 +917,14 @@ push_error stores an error message into the stash to be later retrieved by L</en
 sub push_error
 {
     my ( $self, $c, $params ) = @_;
-    push( @{$c->stash->{_dbic_crud_errors}}, $params->{message} || 'unknown error' );
+    my $error = 'unknown error';
+    if (exists $params->{message}) {
+        $error = $params->{message};
+        # remove newline from die "error message\n" which is required to not
+        # have the filename and line number in the error text
+        $error =~ s/\n$//;
+    }
+    push( @{$c->stash->{_dbic_crud_errors}}, $error);
 }
 
 =method_protected get_errors
@@ -929,9 +982,17 @@ Below are explanations for various configuration parameters. Please see L<Cataly
 
 Whatever you would pass to $c->model to get a resultset for this class. MyAppDB::Track for example.
 
+=head3 resultset_class
+
+Desired resultset class after accessing your model. MyAppDB::ResultSet::Track for example. By default, it's DBIx::Class::ResultClass::HashRefInflator. Set to empty string to leave resultset class without change.
+
+=head3 stash_key
+
+Controls where in stash request_data should be stored, and defaults to 'response'.
+
 =head3 data_root
 
-By default, the response data is serialized into $c->stash->{response}->{$self->data_root} and data_root defaults to 'list' to preserve backwards compatibility. This is now configuable to meet the needs of the consuming client.
+By default, the response data is serialized into $c->stash->{$self->stash_key}->{$self->data_root} and data_root defaults to 'list' to preserve backwards compatibility. This is now configuable to meet the needs of the consuming client.
 
 =head3 use_json_boolean
 
@@ -993,9 +1054,9 @@ Columns and related columns that are okay to search on. For example if only the
 You can also use this to allow custom columns should you wish to allow them through in order to be caught by a custom resultset. For example:
 
   package RestTest::Controller::API::RPC::TrackExposed;
-  
+
   ...
-  
+
   __PACKAGE__->config
     ( ...,
       search_exposes => [qw/position title custom_column/],
@@ -1004,9 +1065,9 @@ You can also use this to allow custom columns should you wish to allow them thro
 and then in your custom resultset:
 
   package RestTest::Schema::ResultSet::Track;
-  
+
   use base 'RestTest::Schema::ResultSet';
-  
+
   sub search {
     my $self = shift;
     my ($clause, $params) = @_;
@@ -1024,7 +1085,7 @@ Arguments to pass to L<DBIx::Class::ResultSet/rows> when performing search for L
 
 =head3 page
 
-Arguments to pass to L<DBIx::Class::ResultSet/rows> when performing search for L</list>.
+Arguments to pass to L<DBIx::Class::ResultSet/page> when performing search for L</list>.
 
 =head1 EXTENDING
 
@@ -1043,13 +1104,12 @@ For example if you wanted create to return the JSON for the newly created object
     # $c->req->all_objects will contain all of the created
     $self->next::method($c);
 
-    if ($c->req->has_objects) {    
-      # $c->stash->{response} will be serialized in the end action
-      $c->stash->{response}->{$self->data_root} = [ map { { $_->get_inflated_columns } } ($c->req->all_objects) ] ;
+    if ($c->req->has_objects) {
+      # $c->stash->{$self->stash_key} will be serialized in the end action
+      $c->stash->{$self->stash_key}->{$self->data_root} = [ map { { $_->get_inflated_columns } } ($c->req->all_objects) ] ;
     }
   }
 
-
   package MyApp::Controller::API::RPC::Track;
   ...
   use Moose;
@@ -1060,7 +1120,7 @@ It should be noted that the return_object attribute will produce the above resul
 
 Similarly you might want create, update and delete to all forward to the list action once they are done so you can refresh your view. This should also be simple enough.
 
-If more extensive customization is required, it is recommened to peer into the roles that comprise the system and make use 
+If more extensive customization is required, it is recommened to peer into the roles that comprise the system and make use
 
 =head1 NOTES