File Coverage

blib/lib/Yancy/Backend/MojoDB.pm
Criterion Covered Total %
statement 18 205 8.7
branch 0 64 0.0
condition 0 64 0.0
subroutine 6 31 19.3
pod n/a
total 24 364 6.5


line stmt bran cond sub pod time code
1             package Yancy::Backend::MojoDB;
2             our $VERSION = '1.088';
3             # ABSTRACT: Abstract base class for drivers based on Mojo DB drivers
4              
5             #pod =head1 SYNOPSIS
6             #pod
7             #pod package Yancy::Backend::RDBMS;
8             #pod use Mojo::Base 'Yancy::Backend::MojoDB';
9             #pod
10             #pod =head1 DESCRIPTION
11             #pod
12             #pod This is an abstract base class for the Mojo database drivers:
13             #pod
14             #pod =over
15             #pod =item L (L)
16             #pod =item L (L)
17             #pod =item L (L)
18             #pod =back
19             #pod
20             #pod =head1 SEE ALSO
21             #pod
22             #pod L, L
23             #pod
24             #pod =cut
25              
26 1     1   1708 use Mojo::Base 'Yancy::Backend';
  1         2  
  1         9  
27 1     1   163 use Role::Tiny 'with';
  1         2  
  1         9  
28 1     1   191 use Scalar::Util qw( blessed looks_like_number );
  1         2  
  1         60  
29 1     1   6 use Mojo::JSON qw( true encode_json );
  1         2  
  1         62  
30 1     1   9 use Carp qw( croak );
  1         2  
  1         138  
31 1     1   7 use Yancy::Util qw( is_type is_format );
  1         2  
  1         4374  
32              
33             with 'Yancy::Backend::Role::DBI';
34             has driver =>;
35 0     0     sub sql_abstract { shift->driver->abstract }
36 0     0     sub dbh { shift->driver->db->dbh }
37              
38             sub create {
39 0     0     my ( $self, $schema_name, $params ) = @_;
40 0           $params = $self->normalize( $schema_name, $params );
41 0           my $id_field = $self->id_field( $schema_name );
42             # For databases that do not have a 'RETURNING' syntax, we must pass in all
43             # parts of a composite key. In the future, we could add a surrogate
44             # key which is auto-increment that could be used to find the
45             # newly-created row so that we can return the correct key fields
46             # here. For now, assume id field is correct if passed, created
47             # otherwise.
48             die "Missing composite ID parts: " . join( ', ', grep !exists $params->{$_}, @$id_field )
49 0 0 0       if ref $id_field eq 'ARRAY' && @$id_field > grep exists $params->{$_}, @$id_field;
50 0           my $res = $self->driver->db->insert( $schema_name, $params );
51 0           my $inserted_id = $res->last_insert_id;
52             return ref $id_field eq 'ARRAY'
53 0   0       ? { map { $_ => $params->{$_} // $inserted_id } @$id_field }
54 0 0 0       : $params->{ $id_field } // $inserted_id
55             ;
56             }
57              
58             sub delete {
59 0     0     my ( $self, $schema_name, $id ) = @_;
60 0           my %where = $self->id_where( $schema_name, $id );
61 0           my $res = eval { $self->driver->db->delete( $schema_name, \%where ) };
  0            
62 0 0         if ( $@ ) {
63 0           croak "Error on delete '$schema_name'=$id: $@";
64             }
65 0           return !!$res->rows;
66             }
67              
68             sub set {
69 0     0     my ( $self, $schema_name, $id, $params ) = @_;
70 0           $params = $self->normalize( $schema_name, $params );
71 0           my %where = $self->id_where( $schema_name, $id );
72 0           my $res = eval { $self->driver->db->update( $schema_name, $params, \%where ) };
  0            
73 0 0         if ( $@ ) {
74 0           croak "Error on set '$schema_name'=$id: $@";
75             }
76 0           return !!$res->rows;
77             }
78              
79             sub _sql_select {
80 0     0     my ( $self, $schema_name, $where, $opt ) = @_;
81 0           my $schema = $self->schema->{ $schema_name };
82 0   0       my $from = ( $schema->{'x-view'} || {} )->{schema} // $schema_name;
      0        
83 0 0         my %props = %{ $schema->{properties} || $self->schema->{ $from }{properties} };
  0            
84 0           my @cols = keys %props;
85              
86 0 0         if ( my $join = $opt->{join} ) {
87             # Make sure everything is fully-qualified
88 0           @cols = map { "$schema_name.$_" } @cols;
  0            
89 0           $where->{ "$schema_name.$_" } = delete $where->{ $_ } for grep !/\./, keys %$where;
90              
91 0           $from = [ $from ];
92 0 0         my @joins = ref $join eq 'ARRAY' ? @$join : ( $join );
93 0           for my $j ( @joins ) {
94 0 0         if ( exists $props{ $j } ) {
    0          
95             # XXX: We should probably deprecate this one, since it
96             # makes no sense to "join" a property field.
97 0           my $join_prop = $props{ $j };
98 0           my ( $join_schema_name, $join_key_field ) = split /\./, $join_prop->{'x-foreign-key'};
99 0           my $join_schema = $self->schema->{ $join_schema_name };
100 0           my $join_props = $join_schema->{properties};
101 0   0       $join_key_field //= $join_schema->{'x-id-field'} // 'id';
      0        
102 0           push @{ $from }, [ -left => \("$join_schema_name AS $j"), "$j.$j", $join_key_field ];
  0            
103 0           push @cols, map { [ "${j}.$_", "${j}_$_" ] } keys %{ $join_props };
  0            
  0            
104             }
105             elsif ( exists $self->schema->{ $j } ) {
106 0           my $join_schema_name = $j;
107 0           my $join_schema = $self->schema->{ $j };
108 0           my $join_props = $join_schema->{properties};
109             # First try to find the foreign key on the local schema
110 0 0 0       if ( my ( $join_prop_name ) = grep { ($props{ $_ }{ 'x-foreign-key' }//'') =~ /^$join_schema_name(\.|$)/ } keys %props ) {
  0 0          
111 0           my $join_prop = $props{ $join_prop_name };
112 0           my ( undef, $join_key_field ) = split /\./, $join_prop->{'x-foreign-key'};
113 0   0       $join_key_field //= $join_schema->{'x-id-field'} // 'id';
      0        
114 0           push @{ $from }, [ -left => $join_schema_name, $join_key_field, $join_prop_name ];
  0            
115 0           push @cols, map { [ "$join_schema_name.$_", "${j}_$_" ] } keys %{ $join_props };
  0            
  0            
116             }
117             # Otherwise, try to find the foreign key on the foreign schema
118 0   0       elsif ( ( $join_prop_name ) = grep { ($join_props->{ $_ }{ 'x-foreign-key' }//'') =~ /^$schema_name(\.|$)/ } keys %$join_props ) {
119 0           my $join_prop = $join_props->{ $join_prop_name };
120 0           my $join_key_field;
121 0 0         if ( $join_prop->{'x-foreign-key'} =~ /\.(.+)$/ ) {
122 0           $join_key_field = $1;
123             }
124             else {
125 0   0       $join_key_field = $schema->{'x-id-field'} // 'id';
126             }
127 0           push @{ $from }, [ -left => $join_schema_name, $join_key_field, $join_prop_name ];
  0            
128 0           push @cols, map { [ "$join_schema_name.$_", "${j}_$_" ] } keys %{ $join_props };
  0            
  0            
129             }
130             else {
131 0           die "Could not join $schema_name to $j: No x-foreign-key property found";
132             }
133             }
134             else {
135 0           die "Could not join $schema_name to $j: No x-foreign-key property found";
136             }
137             }
138             }
139 0           return $from, \@cols, $where;
140             }
141              
142             sub _expand_join {
143 0     0     my ( $self, $schema_name, $res, $joins ) = @_;
144 0 0         my @joins = ref $joins eq 'ARRAY' ? @$joins : ( $joins );
145 0           my $id_field = $self->id_field( $schema_name );
146 0           my %props = %{ $self->schema->{ $schema_name }{properties} };
  0            
147 0           my ( @rows, %rows );
148 0           while ( my $r = $res->hash ) {
149 0           my $row = $rows{ $r->{$id_field} };
150 0 0         if ( !$row ) {
151 0           $row = $r;
152 0           push @rows, $row;
153 0           $rows{ $r->{ $id_field } } = $row;
154             # First instance of the row fills in all one-to-one
155             # relationships
156 0           for my $j ( @joins ) {
157 0 0 0       my $j_id = $self->schema->{ $j } ? ($self->schema->{$j}{'x-id-field'}//'id') : $j;
158             # If the ID field isn't defined, then there was no row
159             # to join. So just remove the columns for the join
160 0 0         if ( !defined $row->{ "${j}_${j_id}" } ) {
161             %$row = (
162             # Keys not in the join
163 0           ( map { $_ => $row->{$_} } grep !/^${j}_/, keys %$row ),
164             # Empty array, if needed
165 0           ( $j => [] )x!!$self->schema->{ $j },
166             );
167 0           next;
168             }
169             %$row = (
170             # Keys not in the join
171 0           ( map { $_ => $row->{$_} } grep !/^${j}_/, keys %$row ),
172             # Keys in the join
173             $j => exists $props{ $j }
174             # One-to-one relationship
175 0           ? { map { s/^${j}_//r => $row->{$_} } grep /^${j}_/, keys %$row }
176             # One-to-many relationship
177 0 0         : [{ map { s/^${j}_//r => $row->{$_} } grep /^${j}_/, keys %$row }]
  0            
178             );
179             }
180 0           next;
181             }
182             # Subsequent rows add to one-to-many relationship
183 0           for my $j ( grep !exists $props{ $_ }, @joins ) {
184 0   0       my $j_id = $self->schema->{$j}{'x-id-field'}//'id';
185             # If the ID field isn't defined, then there was no row
186             # to join. So just skip this.
187 0 0         next if !defined $r->{ "${j}_${j_id}" };
188 0           push @{ $row->{ $j } }, { map { s/^${j}_//r => $r->{$_} } grep /^${j}_/, keys %$r };
  0            
  0            
189             }
190             }
191 0 0         return wantarray ? @rows : $rows[-1];
192             }
193              
194             sub get {
195 0     0     my ( $self, $schema_name, $id, %opt ) = @_;
196 0           my %where = $self->id_where( $schema_name, $id );
197 0           my ( $from, $cols, $where ) = $self->_sql_select( $schema_name, \%where, \%opt );
198 0           my ( $sql, @params ) = $self->driver->abstract->select( $from, $cols, $where );
199 0           my $res = $self->driver->db->query( $sql, @params );
200 0 0         my $row = $opt{join} ? $self->_expand_join( $schema_name, $res, $opt{join} ) : $res->hash;
201 0 0         return $row if !$row;
202 0           return $self->normalize( $schema_name, $row );
203             }
204              
205             sub get_p {
206 0     0     my ( $self, $schema_name, $id, %opt ) = @_;
207 0           my %where = $self->id_where( $schema_name, $id );
208 0           my ( $from, $cols, $where ) = $self->_sql_select( $schema_name, \%where, \%opt );
209 0           my ( $sql, @params ) = $self->driver->abstract->select( $from, $cols, $where );
210 0           my $p = $self->driver->db->query_p( $sql, @params );
211             return $p->then( sub {
212 0     0     my ( $res ) = @_;
213 0 0         my $row = $opt{join} ? $self->_expand_join( $schema_name, $res, $opt{join} ) : $res->hash;
214 0           return $self->normalize( $schema_name, $row );
215 0           });
216             }
217              
218             sub list {
219 0     0     my ( $self, $schema_name, $params, @opt ) = @_;
220 0 0         my $opt = @opt % 2 == 0 ? {@opt} : $opt[0];
221 0   0       $params ||= {}; $opt ||= {};
  0   0        
222 0           my $driver = $self->driver;
223 0           my ( $query, $total_query, @params ) = $self->list_sqls( $schema_name, $params, $opt );
224 0           my $res = $driver->db->query( $query, @params );
225 0 0         my @items = $opt->{join} ? $self->_expand_join( $schema_name, $res, $opt->{join} ) : @{$res->hashes};
  0            
226             return {
227             items => [ map $self->normalize( $schema_name, $_ ), @items ],
228             total => $driver->db->query( $total_query, @params )->hash->{total},
229 0           };
230             }
231              
232             sub create_p {
233 0     0     my ( $self, $schema_name, $params ) = @_;
234 0           $params = $self->normalize( $schema_name, $params );
235 0           my $id_field = $self->id_field( $schema_name );
236             # For databases that do not have a 'RETURNING' syntax, we must pass in all
237             # parts of a composite key. In the future, we could add a surrogate
238             # key which is auto-increment that could be used to find the
239             # newly-created row so that we can return the correct key fields
240             # here. For now, assume id field is correct if passed, created
241             # otherwise.
242             die "Missing composite ID parts: " . join( ', ', grep !exists $params->{$_}, @$id_field )
243 0 0 0       if ref $id_field eq 'ARRAY' && @$id_field > grep exists $params->{$_}, @$id_field;
244             return $self->driver->db->insert_p( $schema_name, $params )
245             ->then( sub {
246 0     0     my $inserted_id = shift->last_insert_id;
247             return ref $id_field eq 'ARRAY'
248 0   0       ? { map { $_ => $params->{$_} // $inserted_id } @$id_field }
249 0 0 0       : $params->{ $id_field } // $inserted_id
250             ;
251 0           } );
252             }
253              
254             sub delete_p {
255 0     0     my ( $self, $schema_name, $id ) = @_;
256 0           my %where = $self->id_where( $schema_name, $id );
257             $self->driver->db->delete_p( $schema_name, \%where )
258 0     0     ->catch(sub { croak "Error on delete '$schema_name'=$id: $_[0]" })
259 0     0     ->then(sub { !!shift->rows } );
  0            
260             }
261              
262             sub set_p {
263 0     0     my ( $self, $schema_name, $id, $params ) = @_;
264 0           $params = $self->normalize( $schema_name, $params );
265 0           my %where = $self->id_where( $schema_name, $id );
266             $self->driver->db->update_p( $schema_name, $params, \%where )
267 0     0     ->catch(sub { croak "Error on set '$schema_name'=$id: $_[0]" })
268 0     0     ->then(sub { !!shift->rows } );
  0            
269             }
270              
271             # XXX: If needed, this can be broken out into its own role based on
272             # SQL::Abstract.
273             sub list_sqls {
274 0     0     my ( $self, $schema_name, $where, $opt ) = @_;
275 0           my $schema = $self->schema->{ $schema_name };
276 0   0       my $id_field = $schema->{'x-id-field'} // 'id';
277 0   0       my $real_schema_name = ( $schema->{'x-view'} || {} )->{schema} // $schema_name;
      0        
278 0           my $sqla = $self->sql_abstract;
279              
280 0           ( my $from, my $cols, $where ) = $self->_sql_select( $schema_name, $where, $opt );
281             #; use Data::Dumper;
282             #; say "From: " . Dumper( $from ) . " Cols: " . Dumper( $cols ) . " Where: " . Dumper( $where );
283             my ( $query, @params ) = $sqla->select(
284             $from, $cols, $where,
285             {
286             order_by => $opt->{order_by},
287             },
288 0           );
289              
290             # XXX: SQL::Abstract::mysql destroys the $from joined table arrays
291 0           ( $from, $cols, $where ) = $self->_sql_select( $schema_name, $where, $opt );
292             my ( $total_query, @total_params ) = $sqla->select(
293             $from,
294 0 0 0       [ grep { !ref && ( /^$schema_name\./ || !/\./ ) } @$cols ],
  0            
295             $where,
296             );
297 0           $total_query =~ s/SELECT/SELECT DISTINCT/i;
298 0           $total_query = 'SELECT COUNT(*) AS total FROM (' . $total_query . ') total_query';
299              
300 0 0         if ( scalar grep defined, @{ $opt }{qw( limit offset )} ) {
  0            
301             # XXX: SQL::Abstract now handles this, so we should move this.
302 0 0 0       die "Limit must be number" if $opt->{limit} && !looks_like_number $opt->{limit};
303 0   0       $query .= ' LIMIT ' . ( $opt->{limit} // 2**32 );
304 0 0         if ( $opt->{offset} ) {
305 0 0         die "Offset must be number" if !looks_like_number $opt->{offset};
306 0           $query .= ' OFFSET ' . $opt->{offset};
307             }
308             }
309             #; say $query;
310             #; say $total_query;
311 0           return ( $query, $total_query, @params );
312             }
313              
314             sub list_p {
315 0     0     my ( $self, $schema_name, $params, @opt ) = @_;
316 0 0         my $opt = @opt % 2 == 0 ? {@opt} : $opt[0];
317 0   0       $params ||= {};
318 0           my $driver = $self->driver;
319 0           my ( $query, $total_query, @params ) = $self->list_sqls( $schema_name, $params, $opt );
320             $driver->db->query_p( $query, @params )->then(
321             sub {
322 0     0     my ( $res ) = @_;
323 0           my $items = $res->hashes;
324             return {
325             items => [ map $self->normalize( $schema_name, $_ ), @$items ],
326             total => $driver->db->query( $total_query, @params )->hash->{total},
327 0           };
328             },
329 0           );
330             }
331              
332             sub query {
333 0     0     my ( $self, @params ) = @_;
334 0           return $self->driver->db->query( @params )->hashes->each;
335             }
336              
337             sub query_p {
338 0     0     my ( $self, @params ) = @_;
339 0     0     return $self->driver->db->query_p( @params )->then( sub { my ( $res ) = @_; return $res->hashes->each } );
  0            
  0            
340             }
341              
342             1;
343              
344             __END__