File Coverage

blib/lib/Yancy/Model/Schema.pm
Criterion Covered Total %
statement 98 99 98.9
branch 33 36 91.6
condition 36 40 90.0
subroutine 15 15 100.0
pod 9 9 100.0
total 191 199 95.9


line stmt bran cond sub pod time code
1             package Yancy::Model::Schema;
2             our $VERSION = '1.088';
3             # ABSTRACT: Interface to a single schema
4              
5             #pod =head1 SYNOPSIS
6             #pod
7             #pod my $schema = $app->model->schema( 'foo' );
8             #pod
9             #pod my $id = $schema->create( $data );
10             #pod my $item = $schema->get( $id );
11             #pod my $count = $schema->delete( $id );
12             #pod my $count = $schema->delete( $where );
13             #pod my $count = $schema->set( $id, $data );
14             #pod my $count = $schema->set( $where, $data );
15             #pod
16             #pod my $res = $schema->list( $where, $opts );
17             #pod for my $item ( @{ $res->{items} } ) { ... }
18             #pod
19             #pod =head1 DESCRIPTION
20             #pod
21             #pod B: This module is experimental and its API may change before
22             #pod Yancy v2!
23             #pod
24             #pod For information on how to extend this module to add your own schema
25             #pod and item methods, see L.
26             #pod
27             #pod =head1 SEE ALSO
28             #pod
29             #pod L, L
30             #pod
31             #pod =cut
32              
33 20     20   12980 use Mojo::Base -base;
  20         51  
  20         147  
34 20     20   3921 use Mojo::JSON qw( true false );
  20         44  
  20         1290  
35 20     20   130 use Yancy::Util qw( json_validator is_type derp );
  20         59  
  20         43360  
36              
37             #pod =attr model
38             #pod
39             #pod The L object that created this schema object.
40             #pod
41             #pod =cut
42              
43             has model => sub { die 'model is required' };
44              
45             #pod =attr name
46             #pod
47             #pod The name of the schema.
48             #pod
49             #pod =cut
50              
51             has name => sub { die 'name is required' };
52              
53             #pod =attr json_schema
54             #pod
55             #pod The JSON Schema for this schema.
56             #pod
57             #pod =cut
58              
59             has json_schema => sub { die 'json_schema is required' };
60              
61 275     275   1078 sub _backend { shift->model->backend };
62             has _item_class => sub {
63             my $self = shift;
64             return $self->model->find_class( Item => $self->name );
65             };
66 8     8   52 sub _log { shift->model->log };
67              
68             sub new {
69 575     575 1 1838 my ( $class, @args ) = @_;
70 575         2005 my $self = $class->SUPER::new( @args );
71 575         5539 $self->_check_json_schema;
72 573         1700 return $self;
73             }
74              
75             #pod =method id_field
76             #pod
77             #pod The ID field for this schema. Either a single string, or an arrayref of
78             #pod strings (for composite keys).
79             #pod
80             #pod =cut
81              
82             sub id_field {
83 1359     1359 1 2483 my ( $self ) = @_;
84 1359   100     3205 return $self->json_schema->{'x-id-field'} // 'id';
85             }
86              
87             #pod =method build_item
88             #pod
89             #pod Turn a hashref of row data into a L object using
90             #pod L to find the correct class.
91             #pod
92             #pod =cut
93              
94             sub build_item {
95 235     235 1 659 my ( $self, $data ) = @_;
96 235         844 return $self->_item_class->new( { data => $data, schema => $self } );
97             }
98              
99             #pod =method validate
100             #pod
101             #pod Validate an item. Returns a list of errors (if any).
102             #pod
103             #pod =cut
104              
105             sub validate {
106 76     76 1 281 my ( $self, $item, %opt ) = @_;
107 76         298 my $schema = $self->json_schema;
108              
109 76 100       669 if ( $opt{ properties } ) {
110             # Only validate these properties
111             $schema = {
112             type => 'object',
113             required => [
114 135 50       226 grep { my $f = $_; grep { $_ eq $f } @{ $schema->{required} || [] } }
  135         164  
  294         678  
  135         361  
115 35         133 @{ $opt{ properties } }
116             ],
117             properties => {
118 134         501 map { $_ => $schema->{properties}{$_} }
119 135         305 grep { exists $schema->{properties}{$_} }
120 35         113 @{ $opt{ properties } }
  35         114  
121             },
122             additionalProperties => 0, # Disallow any other properties
123             };
124             }
125              
126 76         455 my $v = json_validator();
127 76         413 $v->schema( $schema );
128              
129 76         139930 my @errors;
130             # This is a shallow copy of the item that we will change to pass
131             # Yancy-specific additions to schema validation
132 76         548 my %check_item = %$item;
133 76         207 for my $prop_name ( keys %{ $schema->{properties} } ) {
  76         397  
134 438         1239 my $prop = $schema->{properties}{ $prop_name };
135              
136             # These blocks fix problems with validation only. If the
137             # problem is the database understanding the value, it must be
138             # fixed in the backend class.
139              
140             # Pre-filter booleans
141 438 100 100     1118 if ( is_type( $prop->{type}, 'boolean' ) && defined $check_item{ $prop_name } ) {
142 20         56 my $value = $check_item{ $prop_name };
143 20 100 100     115 if ( $value eq 'false' or !$value ) {
144 12         67 $value = false;
145             } else {
146 8         41 $value = true;
147             }
148 20         191 $check_item{ $prop_name } = $value;
149             }
150             # An empty date-time, date, or time must become undef: The empty
151             # string will never pass the format check, but properties that
152             # are allowed to be null can be validated.
153 438 100 100     1032 if ( is_type( $prop->{type}, 'string' ) && $prop->{format} && $prop->{format} =~ /^(?:date-time|date|time)$/ ) {
      100        
154 24 100 100     337 if ( exists $check_item{ $prop_name } && !$check_item{ $prop_name } ) {
    100 66        
      50        
155 1         4 $check_item{ $prop_name } = undef;
156             }
157             # The "now" special value will not validate yet, but will be
158             # replaced by the Backend with something useful
159             elsif ( ($check_item{ $prop_name }//$prop->{default}//'') eq 'now' ) {
160 20         70 $check_item{ $prop_name } = '2021-01-01 00:00:00';
161             }
162             }
163             # Always add dummy passwords to pass required checks
164 438 50 100     1476 if ( $prop->{format} && $prop->{format} eq 'password' && !$check_item{ $prop_name } ) {
      66        
165 0         0 $check_item{ $prop_name } = '';
166             }
167              
168             # XXX: JSON::Validator 4 moved support for readOnly/writeOnly to
169             # the OpenAPI schema classes, but we use JSON Schema internally,
170             # so we need to make support ourselves for now...
171 438 100 100     1218 if ( $prop->{readOnly} && exists $check_item{ $prop_name } ) {
172 1         23 push @errors, JSON::Validator::Error->new(
173             "/$prop_name", "Read-only.",
174             );
175             }
176             }
177              
178 76         586 push @errors, $v->validate( \%check_item );
179 76         61375 return @errors;
180             }
181              
182             #pod =method get
183             #pod
184             #pod Get an item by its ID. Returns a L object.
185             #pod
186             #pod =cut
187              
188             sub get {
189 117     117 1 365 my ( $self, $id, %opt ) = @_;
190 117   100     424 return $self->build_item( $self->_backend->get( $self->name, $id, %opt ) // return undef );
191             }
192              
193             #pod =method list
194             #pod
195             #pod List items. Returns a hash reference with C and C keys. The C is
196             #pod an array ref of L objects. C is the total number of items
197             #pod that would be returned without any C or C options.
198             #pod
199             #pod =cut
200              
201             sub list {
202 68     68 1 209 my ( $self, $where, $opt ) = @_;
203 68         280 my $res = $self->_backend->list( $self->name, $where, $opt );
204 68         179 return { items => [ map { $self->build_item( $_ ) } @{ $res->{items} } ], total => $res->{total} };
  129         1306  
  68         191  
205             }
206              
207             #pod =method create
208             #pod
209             #pod Create a new item. Returns the ID of the created item.
210             #pod
211             #pod =cut
212              
213             sub create {
214 41     41 1 126 my ( $self, $data ) = @_;
215 41 100       188 if ( my @errors = $self->validate( $data ) ) {
216 2         17 $self->_log->error(
217             sprintf 'Error validating new item in schema "%s": %s',
218             $self->name,
219             join ', ', @errors
220             );
221 2         545 die \@errors; # XXX: Throw an exception instead that can stringify to something useful
222             }
223 39         114 my $retval = eval { $self->_backend->create( $self->name, $data ) };
  39         169  
224 39 100       712 if ( my $error = $@ ) {
225 2         18 $self->_log->error(
226             sprintf 'Error creating item in schema "%s": %s',
227             $self->name, $error,
228             );
229 2         392 die $error;
230             }
231 37         404 return $retval;
232             }
233              
234             #pod =method set
235             #pod
236             #pod Set the given fields in an item. See also L.
237             #pod
238             #pod =cut
239              
240             sub set {
241 35     35 1 139 my ( $self, $id, $data ) = @_;
242 35 100       290 if ( my @errors = $self->validate( $data, properties => [ keys %$data ] ) ) {
243 2         12 $self->_log->error(
244             sprintf 'Error validating item with ID "%s" in schema "%s": %s',
245             $id, $self->name,
246             join ', ', @errors
247             );
248 2         684 die \@errors; # XXX: Throw an exception instead that can stringify to something useful
249             }
250 33         129 my $retval = eval { $self->_backend->set( $self->name, $id, $data ) };
  33         156  
251 33 100       676 if ( my $error = $@ ) {
252 2         17 $self->_log->error(
253             sprintf 'Error setting item with ID "%s" in schema "%s": %s',
254             $id, $self->name, $error,
255             );
256 2         432 die $error;
257             }
258 31         144 return $retval;
259             }
260              
261             #pod =method delete
262             #pod
263             #pod Delete an item. See also L.
264             #pod
265             #pod =cut
266              
267             sub delete {
268 18     18 1 72 my ( $self, $id ) = @_;
269             # XXX: Use get() to get the item instance first? Then they could
270             # override delete() to do things...
271 18         62 return $self->_backend->delete( $self->name, $id );
272             }
273              
274             sub _check_json_schema {
275 867     867   1568 my ( $self ) = @_;
276 867         2018 my $name = $self->name;
277 867         4467 my $json_schema = $self->json_schema;
278              
279             # Deprecate x-view. Yancy::Model is a much better
280             # solution to that.
281             derp q{x-view is deprecated and will be removed in v2. }
282             . q{Use Yancy::Model or your database's CREATE VIEW instead}
283 867 100       4945 if $json_schema->{'x-view'};
284              
285 867   100     2194 $json_schema->{ type } //= 'object';
286 867         1497 my $props = $json_schema->{properties};
287 867 100 100     2582 if ( $json_schema->{'x-view'} && !$props ) {
288 116         366 my $real_name = $json_schema->{'x-view'}->{schema};
289 116   50     653 my $real_schema = $self->model->schema( $real_name )
290             // die qq{Could not find x-view schema "$real_name" for schema "$name"};
291 116         338 $props = $real_schema->json_schema->{properties};
292             }
293 867 50       2069 die qq{Schema "$name" has no properties. Does it exist?} if !$props;
294              
295 867         1758 my $id_field = $self->id_field;
296 867 100       6682 my @id_fields = ref $id_field eq 'ARRAY' ? @$id_field : ( $id_field );
297             # ; say "$name ID field: @id_fields";
298             # ; use Data::Dumper;
299             # ; say Dumper $props;
300              
301 867         1681 for my $field ( @id_fields ) {
302 915 100       3243 if ( !$props->{ $field } ) {
303 2         174 die sprintf "ID field missing in properties for schema '%s', field '%s'."
304             . " Add x-id-field to configure the correct ID field name, or"
305             . " add x-ignore to ignore this schema.",
306             $name, $field;
307             }
308             }
309             }
310              
311             1;
312              
313             __END__