code for resolving
[chaz/p5-DBIx-Class-ResultSet-RecursiveUpdate] / lib / DBIx / Class / ResultSet / RecursiveUpdate.pm
1 package DBIx::Class::ResultSet::RecursiveUpdate;
2
3 use version; $VERSION = qv('0.001');
4
5 use warnings;
6 use strict;
7 use Carp;
8 use Scalar::Util qw( blessed );
9
10 use base qw(DBIx::Class::ResultSet);
11
12 sub recursive_update {
13 my( $self, $updates, $fixed_fields ) = @_;
14 if( blessed( $updates ) && $updates->isa( 'DBIx::Class::Row' ) ){
15 return $updates;
16 }
17 my $object;
18 # warn 'cond: ' . Dumper( $self->{cond} ); use Data::Dumper;
19 # warn 'where: ' . Dumper( $self->{attrs}{where} ); use Data::Dumper;
20 my @missing = grep { !exists $updates->{$_} && !exists $fixed_fields->{$_} } $self->result_source->primary_columns;
21 if( defined $self->{cond} && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $self->{cond} ){
22 $self->{cond} = undef;
23 $self->{attrs}{where} = undef;
24 if( ! scalar @missing ){
25 $object = $self->find( $updates, { key => 'primary' } );
26 }
27 }
28 else{
29 $object = $self->find( $updates, { key => 'primary' } );
30 }
31 $object ||= $self->new( {} );
32
33 # first update columns and other accessors - so that later related records can be found
34 for my $name ( keys %$updates ){
35 if( $self->is_for_column( $object, $name, $updates->{$name} ) ) {
36 $object->$name( $updates->{$name} );
37 }
38 }
39 for my $name ( keys %$updates ){
40 if($object->can($name) && !$self->is_for_column( $object, $name, $updates->{$name} ) ){
41
42 # updating relations that that should be done before the row is inserted into the database
43 # like belongs_to
44 my $info = $object->result_source->relationship_info( $name );
45 if( $info and not $info->{attrs}{accessor} eq 'multi'
46 and
47 _master_relation_cond( $object, $info->{cond}, $self->_get_pk_for_related( $name ) )
48 ){
49 my $related_result = $object->related_resultset( $name );
50 my $resolved = $self->result_source->resolve_condition(
51 $info->{cond}, $name, $object
52 );
53 # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
54 my $sub_object = $related_result->recursive_update( $updates->{$name} );
55 $object->set_from_related( $name, $sub_object );
56 }
57 }
58 }
59 $self->_delete_empty_auto_increment($object);
60 # don't allow insert to recurse to related objects - we do the recursion ourselves
61 # $object->{_rel_in_storage} = 1;
62 # warn Dumper( $object->{_column_data} );
63 $object->update_or_insert;
64
65 # updating relations that can be done only after the row is inserted into the database
66 # like has_many and many_to_many
67 for my $name ( keys %$updates ){
68 my $value = $updates->{$name};
69 # many to many case
70 if( $self->is_m2m( $name ) ) {
71 my ( $pk ) = $self->_get_pk_for_related( $name );
72 my @rows;
73 my $result_source = $object->$name->result_source;
74 for my $elem ( @{$updates->{$name}} ){
75 if( ref $elem ){
76 push @rows, $result_source->resultset->find( $elem );
77 }
78 else{
79 push @rows, $result_source->resultset->find( { $pk => $elem } );
80 }
81 }
82 my $set_meth = 'set_' . $name;
83 $object->$set_meth( \@rows );
84 }
85 elsif( $object->result_source->has_relationship($name) ){
86 my $info = $object->result_source->relationship_info( $name );
87 # has many case (and similar)
88 if( ref $updates->{$name} eq 'ARRAY' ){
89 for my $sub_updates ( @{$updates->{$name}} ) {
90 my $sub_object = $object->search_related( $name )->recursive_update( $sub_updates );
91 }
92 }
93 # might_have and has_one case
94 elsif ( ! _master_relation_cond( $object, $info->{cond}, $self->_get_pk_for_related( $name ) ) ){
95 my $sub_object = $object->search_related( $name )->recursive_update( $value );
96 #$object->set_from_related( $name, $sub_object );
97 }
98 }
99 }
100 return $object;
101 }
102
103 sub is_for_column {
104 my( $self, $object, $name, $value ) = @_;
105 return
106 $object->can($name)
107 && !(
108 $object->result_source->has_relationship($name)
109 && ref( $value )
110 )
111 && (
112 $object->result_source->has_column($name)
113 || !$object->can( 'set_' . $name )
114 )
115 }
116
117 sub is_m2m {
118 my( $self, $relation ) = @_;
119 my $rclass = $self->result_class;
120 # DBIx::Class::IntrospectableM2M
121 if( $rclass->can( '_m2m_metadata' ) ){
122 return $rclass->_m2m_metadata->{$relation};
123 }
124 my $object = $self->new({});
125 if ( $object->can($relation) and
126 !$self->result_source->has_relationship($relation) and
127 $object->can( 'set_' . $relation)
128 ){
129 return 1;
130 }
131 return;
132 }
133
134 sub get_m2m_source {
135 my( $self, $relation ) = @_;
136 my $rclass = $self->result_class;
137 # DBIx::Class::IntrospectableM2M
138 if( $rclass->can( '_m2m_metadata' ) ){
139 return $self->result_source
140 ->related_source(
141 $rclass->_m2m_metadata->{$relation}{relation}
142 )
143 ->related_source(
144 $rclass->_m2m_metadata->{$relation}{foreign_relation}
145 );
146 }
147 my $object = $self->new({});
148 my $r = $object->$relation;
149 return $r->result_source;
150 }
151
152
153 sub _delete_empty_auto_increment {
154 my ( $self, $object ) = @_;
155 for my $col ( keys %{$object->{_column_data}}){
156 if( $object->result_source->column_info( $col )->{is_auto_increment}
157 and
158 ( ! defined $object->{_column_data}{$col} or $object->{_column_data}{$col} eq '' )
159 ){
160 delete $object->{_column_data}{$col}
161 }
162 }
163 }
164
165 sub _get_pk_for_related {
166 my ( $self, $relation ) = @_;
167
168 my $result_source;
169 if( $self->result_source->has_relationship( $relation ) ){
170 $result_source = $self->result_source->related_source( $relation );
171 }
172 # many to many case
173 if ( $self->is_m2m( $relation ) ) {
174 $result_source = $self->get_m2m_source( $relation );
175 }
176 return $result_source->primary_columns;
177 }
178
179 sub _master_relation_cond {
180 my ( $object, $cond, @foreign_ids ) = @_;
181 my $foreign_ids_re = join '|', @foreign_ids;
182 if ( ref $cond eq 'HASH' ){
183 for my $f_key ( keys %{$cond} ) {
184 # might_have is not master
185 my $col = $cond->{$f_key};
186 $col =~ s/self\.//;
187 if( $object->column_info( $col )->{is_auto_increment} ){
188 return 0;
189 }
190 if( $f_key =~ /^foreign\.$foreign_ids_re/ ){
191 return 1;
192 }
193 }
194 }elsif ( ref $cond eq 'ARRAY' ){
195 for my $new_cond ( @$cond ) {
196 return 1 if _master_relation_cond( $object, $new_cond, @foreign_ids );
197 }
198 }
199 return;
200 }
201
202
203 1; # Magic true value required at end of module
204 __END__
205
206 =head1 NAME
207
208 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
209
210
211 =head1 VERSION
212
213 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.001
214
215
216 =head1 SYNOPSIS
217
218 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
219
220 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
221
222 Then:
223
224 my $user = $user_rs->recursive_update( {
225 id => 1,
226 owned_dvds => [
227 {
228 id => undef,
229 title => 'One Flew Over the Cuckoo's Nest'
230 }
231 ]
232 }
233 );
234
235
236 =head1 DESCRIPTION
237
238 You can feed the ->create method with a recursive datastructure and have the related records
239 created. Unfortunately you cannot do a similar thing with update_or_create - this module
240 tries to fill that void.
241
242 It is a base class for ResultSets providing just one method: recursive_update
243 which works just like update_or_create but can recursively update or create
244 data objects composed of multiple rows. All rows need to be identified by primary keys
245 - so you need to provide them in the update structure (unless they can be deduced from
246 the parent row - for example when you have a belongs_to relationship).
247 When creating new rows in a table with auto_increment primary keys you need to
248 put 'undef' for the key value - this is then removed
249 and a correct INSERT statement is generated.
250
251 For a many_to_many (pseudo) relation you can supply a list of primary keys
252 from the other table - and it will link the record at hand to those and
253 only those records identified by them. This is convenient for handling web
254 forms with check boxes (or a SELECT box with multiple choice) that let you
255 update such (pseudo) relations.
256
257 For a description how to set up base classes for ResultSets see load_namespaces
258 in DBIx::Class::Schema.
259
260 =head1 DESIGN CHOICES
261
262 =head2 Treatment of many to many pseudo relations
263
264 Matt Trout expressed following criticism of the support for many to many in
265 RecursiveUpdate and since this is an extension of his DBIx::Class I feel obliged to
266 reply to it. It is about two points leading in his opinion to 'fragile and
267 implicitely broken code'.
268
269 1. That I rely on the fact that
270
271 if($object->can($name) and
272 !$object->result_source->has_relationship($name) and
273 $object->can( 'set_' . $name )
274 )
275
276 then $name must be a many to many pseudo relation. And that in a
277 similarly ugly was I find out what is the ResultSource of objects from
278 that many to many pseudo relation.
279
280 2. That I treat uniformly relations and many to many (which are
281 different from relations because they require traversal of the bridge
282 table).
283
284 To answer 1) I've refactored that 'dirty' code into is_m2m and get_m2m_source so
285 that it can be easily overridden. I agree that this code is not too nice - but
286 currenlty it is the only way to do what I need - and I'll replace it as soon as
287 there is a more clean way. I don't think it is extremely brittle - sure it will
288 break if many to many (pseudo) relations don't get 'set_*' methods anymore - but
289 I would say it is rather justified for this kind of change in underlying library
290 to break it.
291
292
293 Ad 2) - first this is not strictly true - RecursiveUpdate does have
294 different code to cope with m2m and other cases (see the point above for
295 example) - but it let's the user to treat m2m and 'normal' relations in a
296 uniform way. I consider this a form of abstraction - it is the work that
297 RecursiveUpdate does for the programmer.
298
299
300 =head1 INTERFACE
301
302 =head1 METHODS
303
304 =head2 recursive_update
305
306 The method that does the work here.
307
308 =head2 is_m2m
309
310 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
311 (pseudo) relation on $self.
312
313 =head2 get_m2m_source
314
315 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
316 to many (pseudo) relation 'name' from $self.
317
318
319 =head1 DIAGNOSTICS
320
321
322 =head1 CONFIGURATION AND ENVIRONMENT
323
324 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
325
326 =head1 DEPENDENCIES
327
328 DBIx::Class
329
330 =head1 INCOMPATIBILITIES
331
332 =for author to fill in:
333
334 None reported.
335
336
337 =head1 BUGS AND LIMITATIONS
338
339 =for author to fill in:
340
341 No bugs have been reported.
342
343 Please report any bugs or feature requests to
344 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
345 L<http://rt.cpan.org>.
346
347
348 =head1 AUTHOR
349
350 Zbigniew Lukasiak C<< <zby@cpan.org> >>
351 Influenced by code by Pedro Melo.
352
353 =head1 LICENCE AND COPYRIGHT
354
355 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
356
357 This module is free software; you can redistribute it and/or
358 modify it under the same terms as Perl itself. See L<perlartistic>.
359
360
361 =head1 DISCLAIMER OF WARRANTY
362
363 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
364 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
365 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
366 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
367 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
368 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
369 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
370 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
371 NECESSARY SERVICING, REPAIR, OR CORRECTION.
372
373 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
374 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
375 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
376 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
377 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
378 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
379 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
380 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
381 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
382 SUCH DAMAGES.
This page took 0.057417 seconds and 4 git commands to generate.