File Coverage

blib/lib/WebAPI/DBIC/Resource/ActiveModel/Role/SetWritable.pm
Criterion Covered Total %
statement 9 25 36.0
branch 0 6 0.0
condition n/a
subroutine 3 7 42.8
pod 0 2 0.0
total 12 40 30.0


line stmt bran cond sub pod time code
1             package WebAPI::DBIC::Resource::ActiveModel::Role::SetWritable;
2             $WebAPI::DBIC::Resource::ActiveModel::Role::SetWritable::VERSION = '0.004001';
3              
4 2     2   36524626 use Devel::Dwarn;
  2         19821  
  2         31  
5 2     2   333 use Carp qw(confess);
  2         5  
  2         140  
6              
7 2     2   1036 use Moo::Role;
  2         39797  
  2         15  
8              
9              
10             requires '_build_content_types_accepted';
11             requires 'render_item_into_body';
12             requires 'decode_json';
13             requires 'set';
14             requires 'prefetch';
15              
16              
17             around '_build_content_types_accepted' => sub {
18             my $orig = shift;
19             my $self = shift;
20             my $types = $self->$orig();
21             unshift @$types, { 'application/json' => 'from_activemodel_json' };
22             return $types;
23             };
24              
25              
26             sub from_activemodel_json {
27 0     0 0   my $self = shift;
28 0           my $item = $self->create_resources_from_activemodel( $self->decode_json($self->request->content) );
29 0           return $self->item($item);
30             }
31              
32              
33             sub create_resources_from_activemodel { # XXX unify with create_resource in SetWritable, like ItemWritable?
34 0     0 0   my ($self, $activemodel) = @_;
35 0           my $item;
36              
37 0           my $schema = $self->set->result_source->schema;
38             # XXX perhaps the transaction wrapper belongs higher in the stack
39             # but it has to be below the auth layer which switches schemas
40             $schema->txn_do(sub {
41              
42 0     0     $item = $self->_create_embedded_resources_from_activemodel($activemodel, $self->set->result_class);
43              
44             # resync with what's (now) in the db to pick up defaulted fields etc
45 0           $item->discard_changes();
46              
47             # called here because create_path() is too late for Web::Machine
48             # and we need it to happen inside the transaction for rollback=1 to work
49 0           $self->render_item_into_body(item => $item, prefetch => $self->prefetch)
50 0 0         if grep {defined $_->{self}} @{$self->prefetch||[]};
  0 0          
51              
52 0 0         $schema->txn_rollback if $self->param('rollback'); # XXX
53 0           });
54              
55 0           return $item;
56             }
57              
58              
59             sub _create_embedded_resources_from_activemodel {
60 0     0     my ($self, $activemodel, $result_class) = @_;
61              
62 0           return $self->set->result_source->schema->resultset($result_class)->create($activemodel);
63             }
64              
65             1;
66              
67             __END__
68              
69             =pod
70              
71             =encoding UTF-8
72              
73             =head1 NAME
74              
75             WebAPI::DBIC::Resource::ActiveModel::Role::SetWritable
76              
77             =head1 VERSION
78              
79             version 0.004001
80              
81             =head1 DESCRIPTION
82              
83             Handles POST requests for resources representing set resources, e.g. to insert
84             rows into a database table.
85              
86             =head1 NAME
87              
88             WebAPI::DBIC::Resource::ActiveModel::Role::SetWritable - methods handling requests to update set resources
89              
90             =head1 AUTHOR
91              
92             Tim Bunce <Tim.Bunce@pobox.com>
93              
94             =head1 COPYRIGHT AND LICENSE
95              
96             This software is copyright (c) 2015 by Tim Bunce.
97              
98             This is free software; you can redistribute it and/or modify it under
99             the same terms as the Perl 5 programming language system itself.
100              
101             =cut