File Coverage

blib/lib/WebAPI/DBIC/Resource/Role/SetWritable.pm
Criterion Covered Total %
statement 9 24 37.5
branch 0 4 0.0
condition n/a
subroutine 3 9 33.3
pod 0 5 0.0
total 12 42 28.5


line stmt bran cond sub pod time code
1             package WebAPI::DBIC::Resource::Role::SetWritable;
2             $WebAPI::DBIC::Resource::Role::SetWritable::VERSION = '0.004001';
3              
4 2     2   27001161 use Devel::Dwarn;
  2         20438  
  2         21  
5 2     2   381 use Carp qw(confess);
  2         5  
  2         117  
6              
7 2     2   1063 use Moo::Role;
  2         43521  
  2         15  
8              
9              
10             requires 'render_set_as_plain';
11             requires 'render_item_into_body';
12             requires 'decode_json';
13             requires 'set';
14             requires 'prefetch';
15             requires 'writable';
16             requires 'path_for_item';
17             requires 'allowed_methods';
18              
19              
20             has item => ( # for POST to create
21             is => 'rw',
22             );
23              
24             has content_types_accepted => (
25             is => 'lazy',
26             );
27              
28             sub _build_content_types_accepted {
29 0     0     return [ {'application/vnd.wapid+json' => 'from_plain_json'} ]
30             }
31              
32             around 'allowed_methods' => sub {
33             my $orig = shift;
34             my $self = shift;
35             my $methods = $self->$orig();
36             push @$methods, 'POST' if $self->writable;
37             return $methods;
38             };
39              
40              
41 0     0 0   sub post_is_create { return 1 }
42              
43 0     0 0   sub create_path_after_handler { return 1 }
44              
45              
46             sub from_plain_json {
47 0     0 0   my $self = shift;
48 0           my $item = $self->create_resource( $self->decode_json($self->request->content) );
49 0           return $self->item($item);
50             }
51              
52              
53             sub create_path {
54 0     0 0   my $self = shift;
55 0           return $self->path_for_item($self->item);
56             }
57              
58              
59             sub create_resource {
60 0     0 0   my ($self, $data) = @_;
61              
62 0           my $item = $self->set->create($data);
63              
64             # resync with what's (now) in the db to pick up defaulted fields etc
65 0           $item->discard_changes();
66              
67             # called here because create_path() is too late for Web::Machine
68 0           $self->render_item_into_body(item => $item)
69 0 0         if grep {defined $_->{self}} @{$self->prefetch||[]};
  0 0          
70              
71 0           return $item;
72             }
73              
74              
75             1;
76              
77             __END__
78              
79             =pod
80              
81             =encoding UTF-8
82              
83             =head1 NAME
84              
85             WebAPI::DBIC::Resource::Role::SetWritable
86              
87             =head1 VERSION
88              
89             version 0.004001
90              
91             =head1 DESCRIPTION
92              
93             Handles POST requests for resources representing set resources, e.g. to insert
94             rows into a database table.
95              
96             Supports the C<application/json> content type.
97              
98             =head1 NAME
99              
100             WebAPI::DBIC::Resource::Role::SetWritable - methods handling requests to update set resources
101              
102             =head1 AUTHOR
103              
104             Tim Bunce <Tim.Bunce@pobox.com>
105              
106             =head1 COPYRIGHT AND LICENSE
107              
108             This software is copyright (c) 2015 by Tim Bunce.
109              
110             This is free software; you can redistribute it and/or modify it under
111             the same terms as the Perl 5 programming language system itself.
112              
113             =cut