lib/Catalyst/Controller/DBIC/API.pm

   1 package Catalyst::Controller::DBIC::API;
   2
   3 #ABSTRACT: Provides a DBIx::Class web service automagically
   4 use Moose;
   5 BEGIN { extends 'Catalyst::Controller'; }
   6
   7 use CGI::Expand ();
   8 use DBIx::Class::ResultClass::HashRefInflator;
   9 use JSON::MaybeXS ();
  10 use Test::Deep::NoTest('eq_deeply');
  11 use MooseX::Types::Moose(':all');
  12 use Moose::Util;
  13 use Scalar::Util( 'blessed', 'reftype' );
  14 use Try::Tiny;
  15 use Catalyst::Controller::DBIC::API::Request;
  16 use DBIx::Class::ResultSet::RecursiveUpdate;
  17 use namespace::autoclean;
  18
  19 has '_json' => (
  20     is         => 'ro',
  21     isa        => JSON::MaybeXS::JSON(),
  22     lazy_build => 1,
  23 );
  24
  25 sub _build__json {
  26
  27     # no ->utf8 here because the request params get decoded by Catalyst
  28     return JSON::MaybeXS->new;
  29 }
  30
  31 with 'Catalyst::Controller::DBIC::API::StoredResultSource',
  32     'Catalyst::Controller::DBIC::API::StaticArguments';
  33
  34 with 'Catalyst::Controller::DBIC::API::RequestArguments' => { static => 1 };
  35
  36 __PACKAGE__->config();
  37
  38 =head1 SYNOPSIS
  39
  40   package MyApp::Controller::API::RPC::Artist;
  41   use Moose;
  42   BEGIN { extends 'Catalyst::Controller::DBIC::API::RPC' }
  43
  44   __PACKAGE__->config
  45     ( # define parent chain action and PathPart
  46       action => {
  47           setup => {
  48               Chained  => '/api/rpc/rpc_base',
  49               PathPart => 'artist',
  50           }
  51       },
  52       class            => 'MyAppDB::Artist',
  53       resultset_class  => 'MyAppDB::ResultSet::Artist',
  54       create_requires  => ['name', 'age'],
  55       create_allows    => ['nickname'],
  56       update_allows    => ['name', 'age', 'nickname'],
  57       update_allows    => ['name', 'age', 'nickname'],
  58       select           => ['name', 'age'],
  59       prefetch         => ['cds'],
  60       prefetch_allows  => [
  61           'cds',
  62           { cds => 'tracks' },
  63           { cds => ['tracks'] },
  64       ],
  65       ordered_by       => ['age'],
  66       search_exposes   => ['age', 'nickname', { cds => ['title', 'year'] }],
  67       data_root        => 'list',
  68       item_root        => 'data',
  69       use_json_boolean => 1,
  70       return_object    => 1,
  71       );
  72
  73   # Provides the following functional endpoints:
  74   # /api/rpc/artist/create
  75   # /api/rpc/artist/list
  76   # /api/rpc/artist/id/[id]/delete
  77   # /api/rpc/artist/id/[id]/update
  78 =cut
  79
  80 =method_private begin
  81
  82  :Private
  83
  84 begin is provided in the base class to setup the Catalyst request object by
  85 applying the DBIC::API::Request role.
  86
  87 =cut
  88
  89 sub begin : Private {
  90     my ( $self, $c ) = @_;
  91
  92     Moose::Util::ensure_all_roles( $c->req,
  93         'Catalyst::Controller::DBIC::API::Request' );
  94 }
  95
  96 =method_protected setup
  97
  98  :Chained('specify.in.subclass.config') :CaptureArgs(0) :PathPart('specify.in.subclass.config')
  99
 100 This action is the chain root of the controller. It must either be overridden or
 101 configured to provide a base PathPart to the action and also a parent action.
 102 For example, for class MyAppDB::Track you might have
 103
 104   package MyApp::Controller::API::RPC::Track;
 105   use Moose;
 106   BEGIN { extends 'Catalyst::Controller::DBIC::API::RPC'; }
 107
 108   __PACKAGE__->config
 109     ( action => { setup => { PathPart => 'track', Chained => '/api/rpc/rpc_base' } },
 110         ...
 111   );
 112
 113   # or
 114
 115   sub setup :Chained('/api/rpc/rpc_base') :CaptureArgs(0) :PathPart('track') {
 116     my ($self, $c) = @_;
 117
 118     $self->next::method($c);
 119   }
 120
 121 This action does nothing by default.
 122
 123 =cut
 124
 125 sub setup : Chained('specify.in.subclass.config') : CaptureArgs(0) :
 126     PathPart('specify.in.subclass.config') { }
 127
 128 =method_protected deserialize
 129
 130  :Chained('setup') :CaptureArgs(0) :PathPart('') :ActionClass('Deserialize')
 131
 132 Absorbs the request data and transforms it into useful bits by using
 133 CGI::Expand->expand_hash and a smattering of JSON->decode for a handful of
 134 arguments.
 135
 136 Current only the following arguments are capable of being expressed as JSON:
 137
 138     search_arg
 139     count_arg
 140     page_arg
 141     ordered_by_arg
 142     grouped_by_arg
 143     prefetch_arg
 144
 145 It should be noted that arguments can used mixed modes in with some caveats.
 146 Each top level arg can be expressed as CGI::Expand with their immediate child
 147 keys expressed as JSON when sending the data application/x-www-form-urlencoded.
 148 Otherwise, you can send content as raw json and it will be deserialized as is
 149 with no CGI::Expand expasion.
 150
 151 =cut
 152
 153 sub deserialize : Chained('setup') : CaptureArgs(0) : PathPart('') :
 154     ActionClass('Deserialize') {
 155     my ( $self, $c ) = @_;
 156     my $req_params;
 157
 158     if ( $c->req->data && scalar( keys %{ $c->req->data } ) ) {
 159         $req_params = $c->req->data;
 160     }
 161     else {
 162         $req_params = CGI::Expand->expand_hash( $c->req->params );
 163
 164         foreach my $param (
 165             @{  [   $self->search_arg,     $self->count_arg,
 166                     $self->page_arg,       $self->offset_arg,
 167                     $self->ordered_by_arg, $self->grouped_by_arg,
 168                     $self->prefetch_arg
 169                 ]
 170             }
 171             )
 172         {
 173             # these params can also be composed of JSON
 174             # but skip if the parameter is not provided
 175             next if not exists $req_params->{$param};
 176
 177             # find out if CGI::Expand was involved
 178             if ( ref $req_params->{$param} eq 'HASH' ) {
 179                 for my $key ( keys %{ $req_params->{$param} } ) {
 180
 181                     # copy the value because JSON::XS will alter it
 182                     # even if decoding failed
 183                     my $value = $req_params->{$param}->{$key};
 184                     try {
 185                         my $deserialized = $self->_json->decode($value);
 186                         $req_params->{$param}->{$key} = $deserialized;
 187                     }
 188                     catch {
 189                         $c->log->debug(
 190                             "Param '$param.$key' did not deserialize appropriately: $_"
 191                         ) if $c->debug;
 192                     }
 193                 }
 194             }
 195             else {
 196                 try {
 197                     my $value        = $req_params->{$param};
 198                     my $deserialized = $self->_json->decode($value);
 199                     $req_params->{$param} = $deserialized;
 200                 }
 201                 catch {
 202                     $c->log->debug(
 203                         "Param '$param' did not deserialize appropriately: $_"
 204                     ) if $c->debug;
 205                 }
 206             }
 207         }
 208     }
 209
 210     $self->inflate_request( $c, $req_params );
 211 }
 212
 213 =method_protected generate_rs
 214
 215 generate_rs is used by inflate_request to get a resultset for the current
 216 request. It receives $c as its only argument.
 217 By default it returns a resultset of the controller's class.
 218 Override this method if you need to manipulate the default implementation of
 219 getting a resultset.
 220
 221 =cut
 222
 223 sub generate_rs {
 224     my ( $self, $c ) = @_;
 225
 226     return $c->model( $c->stash->{class} || $self->class );
 227 }
 228
 229 =method_protected inflate_request
 230
 231 inflate_request is called at the end of deserialize to populate key portions of
 232 the request with the useful bits.
 233
 234 =cut
 235
 236 sub inflate_request {
 237     my ( $self, $c, $params ) = @_;
 238
 239     try {
 240         # set static arguments
 241         $c->req->_set_controller($self);
 242
 243         # set request arguments
 244         $c->req->_set_request_data($params);
 245
 246         # set the current resultset
 247         $c->req->_set_current_result_set( $self->generate_rs($c) );
 248
 249     }
 250     catch {
 251         $c->log->error($_);
 252         $self->push_error( $c, { message => $_ } );
 253         $c->detach();
 254     }
 255 }
 256
 257 =method_protected object_with_id
 258
 259  :Chained('deserialize') :CaptureArgs(1) :PathPart('')
 260
 261 This action is the chain root for all object level actions (such as delete and
 262 update) that operate on a single identifer. The provided identifier will be used
 263 to find that particular object and add it to the request's store ofobjects.
 264
 265 Please see L<Catalyst::Controller::DBIC::API::Request::Context> for more
 266 details on the stored objects.
 267
 268 =cut
 269
 270 sub object_with_id : Chained('deserialize') : CaptureArgs(1) : PathPart('') {
 271     my ( $self, $c, $id ) = @_;
 272
 273     my $vals = $c->req->request_data->{ $self->data_root };
 274     unless ( defined($vals) ) {
 275
 276         # no data root, assume the request_data itself is the payload
 277         $vals = $c->req->request_data;
 278     }
 279
 280     try {
 281         # there can be only one set of data
 282         $c->req->add_object( [ $self->object_lookup( $c, $id ), $vals ] );
 283     }
 284     catch {
 285         $c->log->error($_);
 286         $self->push_error( $c, { message => $_ } );
 287         $c->detach();
 288     }
 289 }
 290
 291 =method_protected objects_no_id
 292
 293  :Chained('deserialize') :CaptureArgs(0) :PathPart('')
 294
 295 This action is the chain root for object level actions (such as create, update,
 296 or delete) that can involve more than one object. The data stored at the
 297 data_root of the request_data will be interpreted as an array of hashes on which
 298 to operate. If the hashes are missing an 'id' key, they will be considered a
 299 new object to be created. Otherwise, the values in the hash will be used to
 300 perform an update. As a special case, a single hash sent will be coerced into
 301 an array.
 302
 303 Please see L<Catalyst::Controller::DBIC::API::Request::Context> for more
 304 details on the stored objects.
 305
 306 =cut
 307
 308 sub objects_no_id : Chained('deserialize') : CaptureArgs(0) : PathPart('') {
 309     my ( $self, $c ) = @_;
 310
 311     if ( $c->req->has_request_data ) {
 312         my $data = $c->req->request_data;
 313         my $vals;
 314
 315         if ( exists( $data->{ $self->data_root } )
 316             && defined( $data->{ $self->data_root } ) )
 317         {
 318             my $root = $data->{ $self->data_root };
 319             if ( reftype($root) eq 'ARRAY' ) {
 320                 $vals = $root;
 321             }
 322             elsif ( reftype($root) eq 'HASH' ) {
 323                 $vals = [$root];
 324             }
 325             else {
 326                 $c->log->error('Invalid request data');
 327                 $self->push_error( $c,
 328                     { message => 'Invalid request data' } );
 329                 $c->detach();
 330             }
 331         }
 332         else {
 333             # no data root, assume the request_data itself is the payload
 334             $vals = [ $c->req->request_data ];
 335         }
 336
 337         foreach my $val (@$vals) {
 338             unless ( exists( $val->{id} ) ) {
 339                 $c->req->add_object(
 340                     [ $c->req->current_result_set->new_result( {} ), $val ] );
 341                 next;
 342             }
 343
 344             try {
 345                 $c->req->add_object(
 346                     [ $self->object_lookup( $c, $val->{id} ), $val ] );
 347             }
 348             catch {
 349                 $c->log->error($_);
 350                 $self->push_error( $c, { message => $_ } );
 351                 $c->detach();
 352             }
 353         }
 354     }
 355 }
 356
 357 =method_protected object_lookup
 358
 359 This method provides the look up functionality for an object based on 'id'.
 360 It is passed the current $c and the id to be used to perform the lookup.
 361 Dies if there is no provided id or if no object was found.
 362
 363 =cut
 364
 365 sub object_lookup {
 366     my ( $self, $c, $id ) = @_;
 367
 368     die 'No valid ID provided for look up' unless defined $id and length $id;
 369     my $object = $c->req->current_result_set->find($id);
 370     die "No object found for id '$id'" unless defined $object;
 371     return $object;
 372 }
 373
 374 =method_protected list
 375
 376 list's steps are broken up into three distinct methods:
 377
 378 =over
 379
 380 =item L</list_munge_parameters>
 381
 382 =item L</list_perform_search>
 383
 384 =item L</list_format_output>.
 385
 386 =back
 387
 388 The goal of this method is to call ->search() on the current_result_set,
 389 change the resultset class of the result (if needed), and return it in
 390 $c->stash->{$self->stash_key}->{$self->data_root}.
 391
 392 Please see the individual methods for more details on what actual processing
 393 takes place.
 394
 395 If the L</select> config param is defined then the hashes will contain only
 396 those columns, otherwise all columns in the object will be returned.
 397 L</select> of course supports the function/procedure calling semantics that
 398 L<DBIx::Class::ResultSet/select> supports.
 399
 400 In order to have proper column names in the result, provide arguments in L</as>
 401 (which also follows L<DBIx::Class::ResultSet/as> semantics.
 402 Similarly L</count>, L</page>, L</grouped_by> and L</ordered_by> affect the
 403 maximum number of rows returned as well as the ordering and grouping.
 404
 405 Note that if select, count, ordered_by or grouped_by request parameters are
 406 present, these will override the values set on the class with select becoming
 407 bound by the select_exposes attribute.
 408
 409 If not all objects in the resultset are required then it's possible to pass
 410 conditions to the method as request parameters. You can use a JSON string as
 411 the 'search' parameter for maximum flexibility or use L<CGI::Expand> syntax.
 412 In the second case the request parameters are expanded into a structure and
 413 then used as the search condition.
 414
 415 For example, these request parameters:
 416
 417  ?search.name=fred&search.cd.artist=luke
 418  OR
 419  ?search={"name":"fred","cd": {"artist":"luke"}}
 420
 421 Would result in this search (where 'name' is a column of the result class, 'cd'
 422 is a relation of the result class and 'artist' is a column of the related class):
 423
 424  $rs->search({ name => 'fred', 'cd.artist' => 'luke' }, { join => ['cd'] })
 425
 426 It is also possible to use a JSON string for expandeded parameters:
 427
 428  ?search.datetime={"-between":["2010-01-06 19:28:00","2010-01-07 19:28:00"]}
 429
 430 Note that if pagination is needed, this can be achieved using a combination of
 431 the L</count> and L</page> parameters. For example:
 432
 433   ?page=2&count=20
 434
 435 Would result in this search:
 436
 437  $rs->search({}, { page => 2, rows => 20 })
 438
 439 =cut
 440
 441 sub list {
 442     my ( $self, $c ) = @_;
 443
 444     $self->list_munge_parameters($c);
 445     $self->list_perform_search($c);
 446     $self->list_format_output($c);
 447
 448     # make sure there are no objects lingering
 449     $c->req->clear_objects();
 450 }
 451
 452 =method_protected list_munge_parameters
 453
 454 list_munge_parameters is a noop by default. All arguments will be passed through
 455 without any manipulation. In order to successfully manipulate the parameters
 456 before the search is performed, simply access
 457 $c->req->search_parameters|search_attributes (ArrayRef and HashRef respectively),
 458 which correspond directly to ->search($parameters, $attributes).
 459 Parameter keys will be in already-aliased form.
 460 To store the munged parameters call $c->req->_set_search_parameters($newparams)
 461 and $c->req->_set_search_attributes($newattrs).
 462
 463 =cut
 464
 465 sub list_munge_parameters { }    # noop by default
 466
 467 =method_protected list_perform_search
 468
 469 list_perform_search executes the actual search. current_result_set is updated to
 470 contain the result returned from ->search. If paging was requested,
 471 search_total_entries will be set as well.
 472
 473 =cut
 474
 475 sub list_perform_search {
 476     my ( $self, $c ) = @_;
 477
 478     try {
 479         my $req = $c->req;
 480
 481         my $rs =
 482             $req->current_result_set->search( $req->search_parameters,
 483             $req->search_attributes );
 484
 485         $req->_set_current_result_set($rs);
 486
 487         $req->_set_search_total_entries(
 488             $req->current_result_set->pager->total_entries )
 489             if $req->has_search_attributes
 490             && ( exists( $req->search_attributes->{page} )
 491             && defined( $req->search_attributes->{page} )
 492             && length( $req->search_attributes->{page} ) );
 493     }
 494     catch {
 495         $c->log->error($_);
 496         $self->push_error( $c,
 497             { message => 'a database error has occured.' } );
 498         $c->detach();
 499     }
 500 }
 501
 502 =method_protected list_format_output
 503
 504 list_format_output prepares the response for transmission across the wire.
 505 A copy of the current_result_set is taken and its result_class is set to
 506 L<DBIx::Class::ResultClass::HashRefInflator>. Each row in the resultset is then
 507 iterated and passed to L</row_format_output> with the result of that call added
 508 to the output.
 509
 510 =cut
 511
 512 sub list_format_output {
 513     my ( $self, $c ) = @_;
 514
 515     my $rs = $c->req->current_result_set->search;
 516     $rs->result_class( $self->result_class ) if $self->result_class;
 517
 518     try {
 519         my $output    = {};
 520         my $formatted = [];
 521
 522         foreach my $row ( $rs->all ) {
 523             push( @$formatted, $self->row_format_output( $c, $row ) );
 524         }
 525
 526         $output->{ $self->data_root } = $formatted;
 527
 528         if ( $c->req->has_search_total_entries ) {
 529             $output->{ $self->total_entries_arg } =
 530                 $c->req->search_total_entries + 0;
 531         }
 532
 533         $c->stash->{ $self->stash_key } = $output;
 534     }
 535     catch {
 536         $c->log->error($_);
 537         $self->push_error( $c,
 538             { message => 'a database error has occured.' } );
 539         $c->detach();
 540     }
 541 }
 542
 543 =method_protected row_format_output
 544
 545 row_format_output is called each row of the inflated output generated from the
 546 search. It receives two arguments, the catalyst context and the hashref that
 547 represents the row. By default, this method is merely a passthrough.
 548
 549 =cut
 550
 551 sub row_format_output {
 552
 553     #my ($self, $c, $row) = @_;
 554     my ( $self, undef, $row ) = @_;
 555     return $row;    # passthrough by default
 556 }
 557
 558 =method_protected item
 559
 560 item will return a single object called by identifier in the uri. It will be
 561 inflated via each_object_inflate.
 562
 563 =cut
 564
 565 sub item {
 566     my ( $self, $c ) = @_;
 567
 568     if ( $c->req->count_objects != 1 ) {
 569         $c->log->error($_);
 570         $self->push_error( $c,
 571             { message => 'No objects on which to operate' } );
 572         $c->detach();
 573     }
 574     else {
 575         $c->stash->{ $self->stash_key }->{ $self->item_root } =
 576             $self->each_object_inflate( $c, $c->req->get_object(0)->[0] );
 577     }
 578 }
 579
 580 =method_protected update_or_create
 581
 582 update_or_create is responsible for iterating any stored objects and performing
 583 updates or creates. Each object is first validated to ensure it meets the
 584 criteria specified in the L</create_requires> and L</create_allows> (or
 585 L</update_allows>) parameters of the controller config. The objects are then
 586 committed within a transaction via L</transact_objects> using a closure around
 587 L</save_objects>.
 588
 589 =cut
 590
 591 sub update_or_create {
 592     my ( $self, $c ) = @_;
 593
 594     if ( $c->req->has_objects ) {
 595         $self->validate_objects($c);
 596         $self->transact_objects( $c, sub { $self->save_objects( $c, @_ ) } );
 597     }
 598     else {
 599         $c->log->error($_);
 600         $self->push_error( $c,
 601             { message => 'No objects on which to operate' } );
 602         $c->detach();
 603     }
 604 }
 605
 606 =method_protected transact_objects
 607
 608 transact_objects performs the actual commit to the database via $schema->txn_do.
 609 This method accepts two arguments, the context and a coderef to be used within
 610 the transaction. All of the stored objects are passed as an arrayref for the
 611 only argument to the coderef.
 612
 613 =cut
 614
 615 sub transact_objects {
 616     my ( $self, $c, $coderef ) = @_;
 617
 618     try {
 619         $self->stored_result_source->schema->txn_do( $coderef,
 620             $c->req->objects );
 621     }
 622     catch {
 623         $c->log->error($_);
 624         $self->push_error( $c,
 625             { message => 'a database error has occured.' } );
 626         $c->detach();
 627     }
 628 }
 629
 630 =method_protected validate_objects
 631
 632 This is a shortcut method for performing validation on all of the stored objects
 633 in the request. Each object's provided values (for create or update) are updated
 634 to the allowed values permitted by the various config parameters.
 635
 636 =cut
 637
 638 sub validate_objects {
 639     my ( $self, $c ) = @_;
 640
 641     try {
 642         foreach my $obj ( $c->req->all_objects ) {
 643             $obj->[1] = $self->validate_object( $c, $obj );
 644         }
 645     }
 646     catch {
 647         my $err = $_;
 648         $c->log->error($err);
 649         $err =~ s/\s+at\s+.+\n$//g;
 650         $self->push_error( $c, { message => $err } );
 651         $c->detach();
 652     }
 653 }
 654
 655 =method_protected validate_object
 656
 657 validate_object takes the context and the object as an argument. It then filters
 658 the passed values in slot two of the tuple through the create|update_allows
 659 configured. It then returns those filtered values. Values that are not allowed
 660 are silently ignored. If there are no values for a particular key, no valid
 661 values at all, or multiple of the same key, this method will die.
 662
 663 =cut
 664
 665 sub validate_object {
 666     my ( $self, $c, $obj ) = @_;
 667     my ( $object, $params ) = @$obj;
 668
 669     my %values;
 670     my %requires_map = map { $_ => 1 } @{
 671           ( $object->in_storage )
 672         ? []
 673         : $c->stash->{create_requires} || $self->create_requires
 674     };
 675
 676     my %allows_map = map { ( ref $_ ) ? %{$_} : ( $_ => 1 ) } (
 677         keys %requires_map,
 678         @{    ( $object->in_storage )
 679             ? ( $c->stash->{update_allows} || $self->update_allows )
 680             : ( $c->stash->{create_allows} || $self->create_allows )
 681         }
 682     );
 683
 684     foreach my $key ( keys %allows_map ) {
 685
 686         # check value defined if key required
 687         my $allowed_fields = $allows_map{$key};
 688
 689         if ( ref $allowed_fields ) {
 690             my $related_source = $object->result_source->related_source($key);
 691             my $related_params = $params->{$key};
 692             my %allowed_related_map = map { $_ => 1 } @$allowed_fields;
 693             my $allowed_related_cols =
 694                   ( $allowed_related_map{'*'} )
 695                 ? [ $related_source->columns ]
 696                 : $allowed_fields;
 697
 698             if (ref($related_params) && reftype($related_params) eq 'ARRAY') {
 699                 my @related_data;
 700                 for my $related_param (@$related_params) {
 701                     my %data;
 702                     foreach my $related_col ( @{$allowed_related_cols} ) {
 703                         if (defined(
 704                                 my $related_col_value =
 705                                     $related_param->{$related_col}
 706                             )
 707                         ) {
 708                             $data{$related_col} = $related_col_value;
 709                         }
 710                     }
 711                     push @related_data, \%data;
 712                 }
 713                 $values{$key} = \@related_data;
 714             }
 715             else {
 716                 foreach my $related_col ( @{$allowed_related_cols} ) {
 717                     if (defined(
 718                             my $related_col_value =
 719                                 $related_params->{$related_col}
 720                         )
 721                     ) {
 722                         $values{$key}{$related_col} = $related_col_value;
 723                     }
 724                 }
 725             }
 726         }
 727         else {
 728             my $value = $params->{$key};
 729
 730             if ( $requires_map{$key} ) {
 731                 unless ( defined($value) ) {
 732
 733                     # if not defined look for default
 734                     $value = $object->result_source->column_info($key)
 735                         ->{default_value};
 736                     unless ( defined $value ) {
 737                         die "No value supplied for ${key} and no default";
 738                     }
 739                 }
 740             }
 741
 742             # check for multiple values
 743             if ( ref($value) && !( reftype($value) eq reftype(JSON::MaybeXS::true) ) )
 744             {
 745                 require Data::Dumper;
 746                 die
 747                     "Multiple values for '${key}': ${\Data::Dumper::Dumper($value)}";
 748             }
 749
 750             # check exists so we don't just end up with hash of undefs
 751             # check defined to account for default values being used
 752             $values{$key} = $value
 753                 if exists $params->{$key} || defined $value;
 754         }
 755     }
 756
 757     unless ( keys %values || !$object->in_storage ) {
 758         die 'No valid keys passed';
 759     }
 760
 761     return \%values;
 762 }
 763
 764 =method_protected delete
 765
 766 delete operates on the stored objects in the request. It first transacts the
 767 objects, deleting them in the database using L</transact_objects> and a closure
 768 around L</delete_objects>, and then clears the request store of objects.
 769
 770 =cut
 771
 772 sub delete {
 773     my ( $self, $c ) = @_;
 774
 775     if ( $c->req->has_objects ) {
 776         $self->transact_objects( $c,
 777             sub { $self->delete_objects( $c, @_ ) } );
 778         $c->req->clear_objects;
 779     }
 780     else {
 781         $c->log->error($_);
 782         $self->push_error( $c,
 783             { message => 'No objects on which to operate' } );
 784         $c->detach();
 785     }
 786 }
 787
 788 =method_protected save_objects
 789
 790 This method is used by update_or_create to perform the actual database
 791 manipulations. It iterates each object calling L</save_object>.
 792
 793 =cut
 794
 795 sub save_objects {
 796     my ( $self, $c, $objects ) = @_;
 797
 798     foreach my $obj (@$objects) {
 799         $self->save_object( $c, $obj );
 800     }
 801 }
 802
 803 =method_protected save_object
 804
 805 save_object first checks to see if the object is already in storage. If so, it
 806 calls L</update_object_from_params> otherwise L</insert_object_from_params>.
 807
 808 =cut
 809
 810 sub save_object {
 811     my ( $self, $c, $obj ) = @_;
 812
 813     my ( $object, $params ) = @$obj;
 814
 815     if ( $object->in_storage ) {
 816         $self->update_object_from_params( $c, $object, $params );
 817     }
 818     else {
 819         $self->insert_object_from_params( $c, $object, $params );
 820     }
 821
 822 }
 823
 824 =method_protected update_object_from_params
 825
 826 update_object_from_params iterates through the params to see if any of them are
 827 pertinent to relations. If so it calls L</update_object_relation> with the
 828 object, and the relation parameters. Then it calls ->update on the object.
 829
 830 =cut
 831
 832 sub update_object_from_params {
 833     my ( $self, $c, $object, $params ) = @_;
 834
 835     $params = {%$params, %{$object->ident_condition}};
 836
 837     my $updated_object =
 838         DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update(
 839         resultset => $c->req->current_result_set,
 840         # unknown_params_ok => 1,
 841         updates => $params,
 842     );
 843
 844     # replace request object with updated one for response
 845     my $vals = $c->req->get_object(0)->[1];
 846     $c->req->clear_objects;
 847     $c->req->add_object( [ $updated_object, $vals ] );
 848 }
 849
 850 =method_protected insert_object_from_params
 851
 852 Sets the columns of the object, then calls ->insert.
 853
 854 =cut
 855
 856 sub insert_object_from_params {
 857
 858     #my ($self, $c, $object, $params) = @_;
 859     my ( $self, undef, $object, $params ) = @_;
 860
 861     my %rels;
 862     while ( my ( $key, $value ) = each %{$params} ) {
 863         if ( ref($value) && !( reftype($value) eq reftype(JSON::MaybeXS::true) ) ) {
 864             $rels{$key} = $value;
 865         }
 866
 867         # accessor = colname
 868         elsif ( $object->can($key) ) {
 869             $object->$key($value);
 870         }
 871
 872         # accessor != colname
 873         else {
 874             my $accessor =
 875                 $object->result_source->column_info($key)->{accessor};
 876             $object->$accessor($value);
 877         }
 878     }
 879
 880     $object->insert;
 881
 882     while ( my ( $k, $v ) = each %rels ) {
 883         if (reftype($v) eq 'ARRAY') {
 884             foreach my $next_v ( @$v ) {
 885                 $object->create_related($k, $next_v);
 886             }
 887         }
 888         else {
 889             $object->create_related($k => $v);
 890         }
 891     }
 892 }
 893
 894 =method_protected delete_objects
 895
 896 Iterates through each object calling L</delete_object>.
 897
 898 =cut
 899
 900 sub delete_objects {
 901     my ( $self, $c, $objects ) = @_;
 902
 903     map { $self->delete_object( $c, $_->[0] ) } @$objects;
 904 }
 905
 906 =method_protected delete_object
 907
 908 Performs the actual ->delete on the object.
 909
 910 =cut
 911
 912 sub delete_object {
 913
 914     #my ($self, $c, $object) = @_;
 915     my ( $self, undef, $object ) = @_;
 916
 917     $object->delete;
 918 }
 919
 920 =method_protected end
 921
 922 end performs the final manipulation of the response before it is serialized.
 923 This includes setting the success of the request both at the HTTP layer and
 924 JSON layer. If configured with return_object true, and there are stored objects
 925 as the result of create or update, those will be inflated according to the
 926 schema and get_inflated_columns
 927
 928 =cut
 929
 930 sub end : Private {
 931     my ( $self, $c ) = @_;
 932
 933     # don't change the http status code if already set elsewhere
 934     unless ( $c->res->status && $c->res->status != 200 ) {
 935         if ( $self->has_errors($c) ) {
 936             $c->res->status(400);
 937         }
 938         else {
 939             $c->res->status(200);
 940         }
 941     }
 942
 943     if ( $c->res->status == 200 ) {
 944         $c->stash->{ $self->stash_key }->{success} =
 945             $self->use_json_boolean ? JSON::MaybeXS::true : 'true';
 946         if ( $self->return_object
 947             && $c->req->has_objects
 948             && ! exists $c->stash->{ $self->stash_key }->{ $self->data_root } ) {
 949             my $returned_objects = [];
 950             push( @$returned_objects, $self->each_object_inflate( $c, $_ ) )
 951                 for map { $_->[0] } $c->req->all_objects;
 952             $c->stash->{ $self->stash_key }->{ $self->data_root } =
 953                 scalar(@$returned_objects) > 1
 954                 ? $returned_objects
 955                 : $returned_objects->[0];
 956         }
 957     }
 958     else {
 959         $c->stash->{ $self->stash_key }->{success} =
 960             $self->use_json_boolean ? JSON::MaybeXS::false : 'false';
 961         $c->stash->{ $self->stash_key }->{messages} = $self->get_errors($c)
 962             if $self->has_errors($c);
 963
 964         # don't return data for error responses
 965         delete $c->stash->{ $self->stash_key }->{ $self->data_root };
 966     }
 967
 968     $c->forward('serialize');
 969 }
 970
 971 =method_protected each_object_inflate
 972
 973 each_object_inflate executes during L</end> and allows hooking into the process
 974 of inflating the objects to return in the response. Receives, the context, and
 975 the object as arguments.
 976
 977 This only executes if L</return_object> if set and if there are any objects to
 978 actually return.
 979
 980 =cut
 981
 982 sub each_object_inflate {
 983
 984     #my ($self, $c, $object) = @_;
 985     my ( $self, undef, $object ) = @_;
 986
 987     return { $object->get_columns };
 988 }
 989
 990 =method_protected serialize
 991
 992 multiple actions forward to serialize which uses Catalyst::Action::Serialize.
 993
 994 =cut
 995
 996 # from Catalyst::Action::Serialize
 997 sub serialize : ActionClass('Serialize') { }
 998
 999 =method_protected push_error
1000
1001 Stores an error message into the stash to be later retrieved by L</end>.
1002 Accepts a Dict[message => Str] parameter that defines the error message.
1003
1004 =cut
1005
1006 sub push_error {
1007     my ( $self, $c, $params ) = @_;
1008     die 'Catalyst app object missing'
1009         unless defined $c;
1010     my $error = 'unknown error';
1011     if ( exists $params->{message} ) {
1012         $error = $params->{message};
1013
1014         # remove newline from die "error message\n" which is required to not
1015         # have the filename and line number in the error text
1016         $error =~ s/\n$//;
1017     }
1018     push( @{ $c->stash->{_dbic_crud_errors} }, $error );
1019 }
1020
1021 =method_protected get_errors
1022
1023 Returns all of the errors stored in the stash.
1024
1025 =cut
1026
1027 sub get_errors {
1028     my ( $self, $c ) = @_;
1029     die 'Catalyst app object missing'
1030         unless defined $c;
1031     return $c->stash->{_dbic_crud_errors};
1032 }
1033
1034 =method_protected has_errors
1035
1036 Returns true if errors are stored in the stash.
1037
1038 =cut
1039
1040 sub has_errors {
1041     my ( $self, $c ) = @_;
1042     die 'Catalyst app object missing'
1043         unless defined $c;
1044     return exists $c->stash->{_dbic_crud_errors};
1045 }
1046
1047 =head1 DESCRIPTION
1048
1049 Easily provide common API endpoints based on your L<DBIx::Class> schema classes.
1050 Module provides both RPC and REST interfaces to base functionality.
1051 Uses L<Catalyst::Action::Serialize> and L<Catalyst::Action::Deserialize> to
1052 serialize response and/or deserialise request.
1053
1054 =head1 OVERVIEW
1055
1056 This document describes base functionlity such as list, create, delete, update
1057 and the setting of config attributes. L<Catalyst::Controller::DBIC::API::RPC>
1058 and L<Catalyst::Controller::DBIC::API::REST> describe details of provided
1059 endpoints to those base methods.
1060
1061 You will need to create a controller for each schema class you require API
1062 endpoints for. For example if your schema has Artist and Track, and you want to
1063 provide a RESTful interface to these, you should create
1064 MyApp::Controller::API::REST::Artist and MyApp::Controller::API::REST::Track
1065 which both subclass L<Catalyst::Controller::DBIC::API::REST>.
1066 Similarly if you wanted to provide an RPC style interface then subclass
1067 L<Catalyst::Controller::DBIC::API::RPC>. You then configure these individually
1068 as specified in L</CONFIGURATION>.
1069
1070 Also note that the test suite of this module has an example application used to
1071 run tests against. It maybe helpful to look at that until a better tutorial is
1072 written.
1073
1074 =head2 CONFIGURATION
1075
1076 Each of your controller classes needs to be configured to point at the relevant
1077 schema class, specify what can be updated and so on, as shown in the L</SYNOPSIS>.
1078
1079 The class, create_requires, create_allows and update_requires parameters can
1080 also be set in the stash like so:
1081
1082   sub setup :Chained('/api/rpc/rpc_base') :CaptureArgs(1) :PathPart('any') {
1083     my ($self, $c, $object_type) = @_;
1084
1085     if ($object_type eq 'artist') {
1086       $c->stash->{class} = 'MyAppDB::Artist';
1087       $c->stash->{create_requires} = [qw/name/];
1088       $c->stash->{update_allows} = [qw/name/];
1089     } else {
1090       $self->push_error($c, { message => "invalid object_type" });
1091       return;
1092     }
1093
1094     $self->next::method($c);
1095   }
1096
1097 Generally it's better to have one controller for each DBIC source with the
1098 config hardcoded, but in some cases this isn't possible.
1099
1100 Note that the Chained, CaptureArgs and PathPart are just standard Catalyst
1101 configuration parameters and that then endpoint specified in Chained - in this
1102 case '/api/rpc/rpc_base' - must actually exist elsewhere in your application.
1103 See L<Catalyst::DispatchType::Chained> for more details.
1104
1105 Below are explanations for various configuration parameters. Please see
1106 L<Catalyst::Controller::DBIC::API::StaticArguments> for more details.
1107
1108 =head3 class
1109
1110 Whatever you would pass to $c->model to get a resultset for this class.
1111 MyAppDB::Track for example.
1112
1113 =head3 resultset_class
1114
1115 Desired resultset class after accessing your model. MyAppDB::ResultSet::Track
1116 for example. By default, it's DBIx::Class::ResultClass::HashRefInflator.
1117 Set to empty string to leave resultset class without change.
1118
1119 =head3 stash_key
1120
1121 Controls where in stash request_data should be stored, and defaults to 'response'.
1122
1123 =head3 data_root
1124
1125 By default, the response data of multiple item actions is serialized into
1126 $c->stash->{$self->stash_key}->{$self->data_root} and data_root defaults to
1127 'list' to preserve backwards compatibility. This is now configuable to meet
1128 the needs of the consuming client.
1129
1130 =head3 item_root
1131
1132 By default, the response data of single item actions is serialized into
1133 $c->stash->{$self->stash_key}->{$self->item_root} and item_root default to
1134 'data'.
1135
1136 =head3 use_json_boolean
1137
1138 By default, the response success status is set to a string value of "true" or
1139 "false". If this attribute is true, JSON::MaybeXS's true() and false() will be
1140 used instead. Note, this does not effect other internal processing of boolean
1141 values.
1142
1143 =head3 count_arg, page_arg, select_arg, search_arg, grouped_by_arg, ordered_by_arg, prefetch_arg, as_arg, total_entries_arg
1144
1145 These attributes allow customization of the component to understand requests
1146 made by clients where these argument names are not flexible and cannot conform
1147 to this components defaults.
1148
1149 =head3 create_requires
1150
1151 Arrayref listing columns required to be passed to create in order for the
1152 request to be valid.
1153
1154 =head3 create_allows
1155
1156 Arrayref listing columns additional to those specified in create_requires that
1157 are not required to create but which create does allow. Columns passed to create
1158 that are not listed in create_allows or create_requires will be ignored.
1159
1160 =head3 update_allows
1161
1162 Arrayref listing columns that update will allow. Columns passed to update that
1163 are not listed here will be ignored.
1164
1165 =head3 select
1166
1167 Arguments to pass to L<DBIx::Class::ResultSet/select> when performing search for
1168 L</list>.
1169
1170 =head3 as
1171
1172 Complements arguments passed to L<DBIx::Class::ResultSet/select> when performing
1173 a search. This allows you to specify column names in the result for RDBMS
1174 functions, etc.
1175
1176 =head3 select_exposes
1177
1178 Columns and related columns that are okay to return in the resultset since
1179 clients can request more or less information specified than the above select
1180 argument.
1181
1182 =head3 prefetch
1183
1184 Arguments to pass to L<DBIx::Class::ResultSet/prefetch> when performing search
1185 for L</list>.
1186
1187 =head3 prefetch_allows
1188
1189 Arrayref listing relationships that are allowed to be prefetched.
1190 This is necessary to avoid denial of service attacks in form of
1191 queries which would return a large number of data
1192 and unwanted disclosure of data.
1193
1194 =head3 grouped_by
1195
1196 Arguments to pass to L<DBIx::Class::ResultSet/group_by> when performing search
1197 for L</list>.
1198
1199 =head3 ordered_by
1200
1201 Arguments to pass to L<DBIx::Class::ResultSet/order_by> when performing search
1202 for L</list>.
1203
1204 =head3 search_exposes
1205
1206 Columns and related columns that are okay to search on. For example if only the
1207 position column and all cd columns were to be allowed
1208
1209  search_exposes => [qw/position/, { cd => ['*'] }]
1210
1211 You can also use this to allow custom columns should you wish to allow them
1212 through in order to be caught by a custom resultset. For example:
1213
1214   package RestTest::Controller::API::RPC::TrackExposed;
1215
1216   ...
1217
1218   __PACKAGE__->config
1219     ( ...,
1220       search_exposes => [qw/position title custom_column/],
1221     );
1222
1223 and then in your custom resultset:
1224
1225   package RestTest::Schema::ResultSet::Track;
1226
1227   use base 'RestTest::Schema::ResultSet';
1228
1229   sub search {
1230     my $self = shift;
1231     my ($clause, $params) = @_;
1232
1233     # test custom attrs
1234     if (my $pretend = delete $clause->{custom_column}) {
1235       $clause->{'cd.year'} = $pretend;
1236     }
1237     my $rs = $self->SUPER::search(@_);
1238   }
1239
1240 =head3 count
1241
1242 Arguments to pass to L<DBIx::Class::ResultSet/rows> when performing search for
1243 L</list>.
1244
1245 =head3 page
1246
1247 Arguments to pass to L<DBIx::Class::ResultSet/page> when performing search for
1248 L</list>.
1249
1250 =head1 EXTENDING
1251
1252 By default the create, delete and update actions will not return anything apart
1253 from the success parameter set in L</end>, often this is not ideal but the
1254 required behaviour varies from application to application. So normally it's
1255 sensible to write an intermediate class which your main controller classes
1256 subclass from.
1257
1258 For example if you wanted create to return the JSON for the newly created
1259 object you might have something like:
1260
1261   package MyApp::ControllerBase::DBIC::API::RPC;
1262   ...
1263   use Moose;
1264   BEGIN { extends 'Catalyst::Controller::DBIC::API::RPC' };
1265   ...
1266   sub create :Chained('setup') :Args(0) :PathPart('create') {
1267     my ($self, $c) = @_;
1268
1269     # $c->req->all_objects will contain all of the created
1270     $self->next::method($c);
1271
1272     if ($c->req->has_objects) {
1273       # $c->stash->{$self->stash_key} will be serialized in the end action
1274       $c->stash->{$self->stash_key}->{$self->data_root} = [ map { { $_->get_inflated_columns } } ($c->req->all_objects) ] ;
1275     }
1276   }
1277
1278   package MyApp::Controller::API::RPC::Track;
1279   ...
1280   use Moose;
1281   BEGIN { extends 'MyApp::ControllerBase::DBIC::API::RPC' };
1282   ...
1283
1284 It should be noted that the return_object attribute will produce the above
1285 result for you, free of charge.
1286
1287 Similarly you might want create, update and delete to all forward to the list
1288 action once they are done so you can refresh your view. This should also be
1289 simple enough.
1290
1291 If more extensive customization is required, it is recommened to peer into the
1292 roles that comprise the system and make use
1293
1294 =head1 NOTES
1295
1296 It should be noted that version 1.004 and above makes a rapid depature from the
1297 status quo. The internals were revamped to use more modern tools such as Moose
1298 and its role system to refactor functionality out into self-contained roles.
1299
1300 To this end, internally, this module now understands JSON boolean values (as
1301 represented by the JSON::MaybeXS module) and will Do The Right Thing in
1302 handling those values. This means you can have ColumnInflators installed that
1303 can covert between JSON booleans and whatever your database wants for boolean
1304 values.
1305
1306 Validation for various *_allows or *_exposes is now accomplished via
1307 Data::DPath::Validator with a lightly simplified, via a subclass of
1308 Data::DPath::Validator::Visitor.
1309
1310 The rough jist of the process goes as follows: Arguments provided to those
1311 attributes are fed into the Validator and Data::DPaths are generated.
1312 Then incoming requests are validated against these paths generated.
1313 The validator is set in "loose" mode meaning only one path is required to match.
1314 For more information, please see L<Data::DPath::Validator> and more specifically
1315 L<Catalyst::Controller::DBIC::API::Validator>.
1316
1317 Since 2.001:
1318 Transactions are used. The stash is put aside in favor of roles applied to the
1319 request object with additional accessors.
1320 Error handling is now much more consistent with most errors immediately detaching.
1321 The internals are much easier to read and understand with lots more documentation.
1322
1323 Since 2.006:
1324 The SQL::Abstract -and, -not and -or operators are supported.
1325
1326 =cut
1327
1328 1;