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.086';
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   12717 use Mojo::Base -base;
  20         51  
  20         218  
34 20     20   3916 use Mojo::JSON qw( true false );
  20         61  
  20         1341  
35 20     20   130 use Yancy::Util qw( json_validator is_type derp );
  20         49  
  20         42490  
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 270     270   1052 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   35 sub _log { shift->model->log };
67              
68             sub new {
69 491     491 1 1538 my ( $class, @args ) = @_;
70 491         1659 my $self = $class->SUPER::new( @args );
71 491         4791 $self->_check_json_schema;
72 489         1372 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 1190     1190 1 2265 my ( $self ) = @_;
84 1190   100     2725 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 233     233 1 549 my ( $self, $data ) = @_;
96 233         806 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 73     73 1 227 my ( $self, $item, %opt ) = @_;
107 73         251 my $schema = $self->json_schema;
108              
109 73 100       545 if ( $opt{ properties } ) {
110             # Only validate these properties
111             $schema = {
112             type => 'object',
113             required => [
114 135 50       334 grep { my $f = $_; grep { $_ eq $f } @{ $schema->{required} || [] } }
  135         172  
  294         676  
  135         320  
115 35         102 @{ $opt{ properties } }
116             ],
117             properties => {
118 134         436 map { $_ => $schema->{properties}{$_} }
119 135         283 grep { exists $schema->{properties}{$_} }
120 35         96 @{ $opt{ properties } }
  35         85  
121             },
122             additionalProperties => 0, # Disallow any other properties
123             };
124             }
125              
126 73         405 my $v = json_validator();
127 73         344 $v->schema( $schema );
128              
129 73         128723 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 73         539 my %check_item = %$item;
133 73         188 for my $prop_name ( keys %{ $schema->{properties} } ) {
  73         318  
134 429         1079 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 429 100 100     1062 if ( is_type( $prop->{type}, 'boolean' ) && defined $check_item{ $prop_name } ) {
142 20         45 my $value = $check_item{ $prop_name };
143 20 100 100     97 if ( $value eq 'false' or !$value ) {
144 12         50 $value = false;
145             } else {
146 8         41 $value = true;
147             }
148 20         164 $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 429 100 100     955 if ( is_type( $prop->{type}, 'string' ) && $prop->{format} && $prop->{format} =~ /^(?:date-time|date|time)$/ ) {
      100        
154 24 100 100     364 if ( exists $check_item{ $prop_name } && !$check_item{ $prop_name } ) {
    100 66        
      50        
155 1         3 $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         61 $check_item{ $prop_name } = '2021-01-01 00:00:00';
161             }
162             }
163             # Always add dummy passwords to pass required checks
164 429 50 100     1433 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 429 100 100     1006 if ( $prop->{readOnly} && exists $check_item{ $prop_name } ) {
172 1         25 push @errors, JSON::Validator::Error->new(
173             "/$prop_name", "Read-only.",
174             );
175             }
176             }
177              
178 73         474 push @errors, $v->validate( \%check_item );
179 73         57191 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 116     116 1 419 my ( $self, $id, %opt ) = @_;
190 116   100     415 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 67     67 1 201 my ( $self, $where, $opt ) = @_;
203 67         261 my $res = $self->_backend->list( $self->name, $where, $opt );
204 67         177 return { items => [ map { $self->build_item( $_ ) } @{ $res->{items} } ], total => $res->{total} };
  128         1230  
  67         206  
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 38     38 1 118 my ( $self, $data ) = @_;
215 38 100       158 if ( my @errors = $self->validate( $data ) ) {
216 2         13 $self->_log->error(
217             sprintf 'Error validating new item in schema "%s": %s',
218             $self->name,
219             join ', ', @errors
220             );
221 2         367 die \@errors; # XXX: Throw an exception instead that can stringify to something useful
222             }
223 36         100 my $retval = eval { $self->_backend->create( $self->name, $data ) };
  36         157  
224 36 100       599 if ( my $error = $@ ) {
225 2         16 $self->_log->error(
226             sprintf 'Error creating item in schema "%s": %s',
227             $self->name, $error,
228             );
229 2         229 die $error;
230             }
231 34         373 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 122 my ( $self, $id, $data ) = @_;
242 35 100       237 if ( my @errors = $self->validate( $data, properties => [ keys %$data ] ) ) {
243 2         14 $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         546 die \@errors; # XXX: Throw an exception instead that can stringify to something useful
249             }
250 33         137 my $retval = eval { $self->_backend->set( $self->name, $id, $data ) };
  33         129  
251 33 100       520 if ( my $error = $@ ) {
252 2         15 $self->_log->error(
253             sprintf 'Error setting item with ID "%s" in schema "%s": %s',
254             $id, $self->name, $error,
255             );
256 2         233 die $error;
257             }
258 31         122 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 64 my ( $self, $id ) = @_;
269             # XXX: Use get() to get the item instance first? Then they could
270             # override delete() to do things...
271 18         61 return $self->_backend->delete( $self->name, $id );
272             }
273              
274             sub _check_json_schema {
275 741     741   1338 my ( $self ) = @_;
276 741         1704 my $name = $self->name;
277 741         3781 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 741 100       4199 if $json_schema->{'x-view'};
284              
285 741   100     1901 $json_schema->{ type } //= 'object';
286 741         1268 my $props = $json_schema->{properties};
287 741 100 100     2266 if ( $json_schema->{'x-view'} && !$props ) {
288 113         327 my $real_name = $json_schema->{'x-view'}->{schema};
289 113   50     576 my $real_schema = $self->model->schema( $real_name )
290             // die qq{Could not find x-view schema "$real_name" for schema "$name"};
291 113         362 $props = $real_schema->json_schema->{properties};
292             }
293 741 50       1840 die qq{Schema "$name" has no properties. Does it exist?} if !$props;
294              
295 741         1572 my $id_field = $self->id_field;
296 741 100       5362 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 741         1379 for my $field ( @id_fields ) {
302 765 100       2560 if ( !$props->{ $field } ) {
303 2         76 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__