b4ba9b8f57e630d76c8e947229279911cd525976
[chaz/p5-DBIx-Class-ResultSet-RecursiveUpdate] / lib / DBIx / Class / ResultSet / RecursiveUpdate.pm
1 use strict;
2 use warnings;
3 package DBIx::Class::ResultSet::RecursiveUpdate;
4
5 use version; our $VERSION = qv('0.008');
6
7 use base qw(DBIx::Class::ResultSet);
8
9 sub recursive_update {
10 my ( $self, $updates, $fixed_fields ) = @_;
11 return DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update(
12 resultset => $self,
13 updates => $updates,
14 fixed_fields => $fixed_fields
15 );
16 }
17
18 package DBIx::Class::ResultSet::RecursiveUpdate::Functions;
19 use Carp;
20 use Scalar::Util qw( blessed );
21
22
23 sub recursive_update {
24 my %params = @_;
25 my ( $self, $updates, $fixed_fields, $object ) = @params{ qw/resultset updates fixed_fields object/ };
26 # warn 'entering: ' . $self->result_source->from();
27 carp 'fixed fields needs to be an array ref' if $fixed_fields && ref($fixed_fields) ne 'ARRAY';
28 my %fixed_fields;
29 %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields;
30 if ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) {
31 return $updates;
32 }
33 # warn Dumper( $updates ); use Data::Dumper;
34 # direct column accessors
35 my %columns;
36
37 # relations that that should be done before the row is inserted into the database
38 # like belongs_to
39 my %pre_updates;
40
41 # relations that that should be done after the row is inserted into the database
42 # like has_many and might_have
43 my %post_updates;
44 my %other_methods;
45 my %columns_by_accessor = _get_columns_by_accessor( $self );
46 for my $name ( keys %$updates ) {
47 my $source = $self->result_source;
48 if( $name eq 'id'
49 # && scalar @{$source->primary_columns} == 1
50 && !$source->has_column( 'id' )
51 ){
52 my @ids = ( $updates->{id} );
53 if( ref $updates->{id} ){
54 @ids = @{ $updates->{id} };
55 }
56 my $i = 0;
57 for my $key ( $source->primary_columns ){
58 $columns{ $key } = $ids[ $i++ ];
59 }
60 next;
61 }
62 if ( $columns_by_accessor{$name}
63 && !( $source->has_relationship($name) && ref( $updates->{$name} ) )
64 )
65 {
66 $columns{$name} = $updates->{$name};
67 next;
68 }
69 if( !( $source->has_relationship($name) ) ){
70 $other_methods{$name} = $updates->{$name};
71 next;
72 }
73 my $info = $source->relationship_info($name);
74 if (
75 _master_relation_cond(
76 $source, $info->{cond}, _get_pk_for_related( $self, $name)
77 )
78 )
79 {
80 $pre_updates{$name} = $updates->{$name};
81 }
82 else {
83 $post_updates{$name} = $updates->{$name};
84 }
85 }
86 # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper;
87
88 my @missing =
89 grep { !exists $columns{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;
90 if ( !$object && !scalar @missing ) {
91 $object = $self->find( \%columns, { key => 'primary' } );
92 }
93 $object ||= $self->new( {} );
94 # first update columns and other accessors - so that later related records can be found
95 for my $name ( keys %columns ) {
96 $object->$name( $columns{$name} );
97 }
98 for my $name ( keys %other_methods) {
99 $object->$name( $updates->{$name} ) if $object->can( $name );
100 }
101 for my $name ( keys %pre_updates ) {
102 my $info = $object->result_source->relationship_info($name);
103 _update_relation( $self, $name, $updates, $object, $info );
104 }
105 # $self->_delete_empty_auto_increment($object);
106 # don't allow insert to recurse to related objects - we do the recursion ourselves
107 # $object->{_rel_in_storage} = 1;
108 $object->update_or_insert;
109
110 # updating many_to_many
111 for my $name ( keys %$updates ) {
112 next if exists $columns{$name};
113 my $value = $updates->{$name};
114
115 if ( is_m2m( $self, $name) ) {
116 my ($pk) = _get_pk_for_related( $self, $name);
117 my @rows;
118 my $result_source = $object->$name->result_source;
119 my @updates;
120 if( ! defined $value ){
121 next;
122 }
123 elsif( ref $value ){
124 @updates = @{ $value };
125 }
126 else{
127 @updates = ( $value );
128 }
129 for my $elem ( @updates ) {
130 if ( ref $elem ) {
131 push @rows, $result_source->resultset->find($elem);
132 }
133 else {
134 push @rows,
135 $result_source->resultset->find( { $pk => $elem } );
136 }
137 }
138 my $set_meth = 'set_' . $name;
139 $object->$set_meth( \@rows );
140 }
141 }
142 for my $name ( keys %post_updates ) {
143 my $info = $object->result_source->relationship_info($name);
144 _update_relation( $self, $name, $updates, $object, $info );
145 }
146 return $object;
147 }
148
149 sub _get_columns_by_accessor {
150 my $self = shift;
151 my $source = $self->result_source;
152 my %columns;
153 for my $name ( $source->columns ) {
154 my $info = $source->column_info($name);
155 $info->{name} = $name;
156 $columns{ $info->{accessor} || $name } = $info;
157 }
158 return %columns;
159 }
160
161 sub _update_relation {
162 my ( $self, $name, $updates, $object, $info ) = @_;
163 my $related_result =
164 $self->related_resultset($name)->result_source->resultset;
165 my $resolved;
166 if( $self->result_source->can( '_resolve_condition' ) ){
167 $resolved = $self->result_source->_resolve_condition( $info->{cond}, $name, $object );
168 }
169 else{
170 $resolved = $self->result_source->resolve_condition( $info->{cond}, $name, $object );
171 }
172
173 # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
174 $resolved = undef
175 if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $resolved;
176 if ( ref $updates->{$name} eq 'ARRAY' ) {
177 for my $sub_updates ( @{ $updates->{$name} } ) {
178 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
179 my $sub_object =
180 recursive_update( resultset => $related_result, updates => $sub_updates );
181 }
182 }
183 else {
184 my $sub_updates = $updates->{$name};
185 my $sub_object;
186 if( ref $sub_updates ){
187 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
188 # for might_have relationship
189 if( $info->{attrs}{accessor} eq 'single' && defined $object->$name ){
190 $sub_object = recursive_update(
191 resultset => $related_result,
192 updates => $sub_updates,
193 object => $object->$name
194 );
195 }
196 else{
197 $sub_object =
198 recursive_update( resultset => $related_result, updates => $sub_updates );
199 }
200 }
201 elsif( ! ref $sub_updates ){
202 $sub_object = $related_result->find( $sub_updates );
203 }
204 $object->set_from_related( $name, $sub_object );
205 }
206 }
207
208 sub is_m2m {
209 my ( $self, $relation ) = @_;
210 my $rclass = $self->result_class;
211
212 # DBIx::Class::IntrospectableM2M
213 if ( $rclass->can('_m2m_metadata') ) {
214 return $rclass->_m2m_metadata->{$relation};
215 }
216 my $object = $self->new( {} );
217 if ( $object->can($relation)
218 and !$self->result_source->has_relationship($relation)
219 and $object->can( 'set_' . $relation ) )
220 {
221 return 1;
222 }
223 return;
224 }
225
226 sub get_m2m_source {
227 my ( $self, $relation ) = @_;
228 my $rclass = $self->result_class;
229
230 # DBIx::Class::IntrospectableM2M
231 if ( $rclass->can('_m2m_metadata') ) {
232 return $self->result_source->related_source(
233 $rclass->_m2m_metadata->{$relation}{relation} )
234 ->related_source(
235 $rclass->_m2m_metadata->{$relation}{foreign_relation} );
236 }
237 my $object = $self->new( {} );
238 my $r = $object->$relation;
239 return $r->result_source;
240 }
241
242 sub _delete_empty_auto_increment {
243 my ( $self, $object ) = @_;
244 for my $col ( keys %{ $object->{_column_data} } ) {
245 if (
246 $object->result_source->column_info($col)->{is_auto_increment}
247 and ( !defined $object->{_column_data}{$col}
248 or $object->{_column_data}{$col} eq '' )
249 )
250 {
251 delete $object->{_column_data}{$col};
252 }
253 }
254 }
255
256 sub _get_pk_for_related {
257 my ( $self, $relation ) = @_;
258 my $result_source;
259 if ( $self->result_source->has_relationship($relation) ) {
260 $result_source = $self->result_source->related_source($relation);
261 }
262
263 # many to many case
264 if ( is_m2m($self, $relation) ) {
265 $result_source = get_m2m_source($self, $relation);
266 }
267 return $result_source->primary_columns;
268 }
269
270 sub _master_relation_cond {
271 my ( $source, $cond, @foreign_ids ) = @_;
272 my $foreign_ids_re = join '|', @foreign_ids;
273 if ( ref $cond eq 'HASH' ) {
274 for my $f_key ( keys %{$cond} ) {
275
276 # might_have is not master
277 my $col = $cond->{$f_key};
278 $col =~ s/self\.//;
279 if ( $source->column_info($col)->{is_auto_increment} ) {
280 return 0;
281 }
282 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
283 return 1;
284 }
285 }
286 }
287 elsif ( ref $cond eq 'ARRAY' ) {
288 for my $new_cond (@$cond) {
289 return 1
290 if _master_relation_cond( $source, $new_cond, @foreign_ids );
291 }
292 }
293 return;
294 }
295
296 1; # Magic true value required at end of module
297 __END__
298
299 =head1 NAME
300
301 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
302
303
304 =head1 VERSION
305
306 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.006
307
308
309 =head1 SYNOPSIS
310
311 The functional interface:
312
313 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
314 resultset => $schema->resultset( 'Dvd' ),
315 updates => {
316 id => 1,
317 owned_dvds => [
318 {
319 title => 'One Flew Over the Cuckoo's Nest'
320 }
321 ]
322 }
323 });
324
325
326 As ResultSet subclass:
327
328 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
329
330 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
331
332 Then:
333
334 my $user = $user_rs->recursive_update( {
335 id => 1,
336 owned_dvds => [
337 {
338 title => 'One Flew Over the Cuckoo's Nest'
339 }
340 ]
341 }
342 );
343
344
345 =head1 DESCRIPTION
346 This is still experimental. I've added a functional interface so that it can be used
347 in Form Processors and not require modification of the model.
348
349 You can feed the ->create method with a recursive datastructure and have the related records
350 created. Unfortunately you cannot do a similar thing with update_or_create - this module
351 tries to fill that void.
352
353 It is a base class for ResultSets providing just one method: recursive_update
354 which works just like update_or_create but can recursively update or create
355 data objects composed of multiple rows. All rows need to be identified by primary keys
356 - so you need to provide them in the update structure (unless they can be deduced from
357 the parent row - for example when you have a belongs_to relationship).
358 If not all colums comprising the primary key are specified - then a new row will be created,
359 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
360 primary keys).
361
362
363 If the resultset itself stores an assignement for the primary key,
364 like in the case of:
365
366 my $restricted_rs = $user_rs->search( { id => 1 } );
367
368 then you need to inform recursive_update about additional predicate with a second argument:
369
370 my $user = $restricted_rs->recursive_update( {
371 owned_dvds => [
372 {
373 title => 'One Flew Over the Cuckoo's Nest'
374 }
375 ]
376 },
377 [ 'id' ]
378 );
379
380 This will work with a new DBIC release.
381
382 For a many_to_many (pseudo) relation you can supply a list of primary keys
383 from the other table - and it will link the record at hand to those and
384 only those records identified by them. This is convenient for handling web
385 forms with check boxes (or a SELECT box with multiple choice) that let you
386 update such (pseudo) relations.
387
388 For a description how to set up base classes for ResultSets see load_namespaces
389 in DBIx::Class::Schema.
390
391 =head1 DESIGN CHOICES
392
393 =head2 Treatment of many to many pseudo relations
394
395 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
396 If it is not loaded in the ResultSource classes - then the code relies on the fact that:
397 if($object->can($name) and
398 !$object->result_source->has_relationship($name) and
399 $object->can( 'set_' . $name )
400 )
401
402 then $name must be a many to many pseudo relation. And that in a
403 similarly ugly was I find out what is the ResultSource of objects from
404 that many to many pseudo relation.
405
406
407 =head1 INTERFACE
408
409 =head1 METHODS
410
411 =head2 recursive_update
412
413 The method that does the work here.
414
415 =head2 is_m2m
416
417 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
418 (pseudo) relation on $self.
419
420 =head2 get_m2m_source
421
422 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
423 to many (pseudo) relation 'name' from $self.
424
425
426 =head1 DIAGNOSTICS
427
428
429 =head1 CONFIGURATION AND ENVIRONMENT
430
431 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
432
433 =head1 DEPENDENCIES
434
435 DBIx::Class
436
437 =head1 INCOMPATIBILITIES
438
439 =for author to fill in:
440
441 None reported.
442
443
444 =head1 BUGS AND LIMITATIONS
445
446 =for author to fill in:
447
448 No bugs have been reported.
449
450 Please report any bugs or feature requests to
451 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
452 L<http://rt.cpan.org>.
453
454
455 =head1 AUTHOR
456
457 Zbigniew Lukasiak C<< <zby@cpan.org> >>
458 Influenced by code by Pedro Melo.
459
460 =head1 LICENCE AND COPYRIGHT
461
462 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
463
464 This module is free software; you can redistribute it and/or
465 modify it under the same terms as Perl itself. See L<perlartistic>.
466
467
468 =head1 DISCLAIMER OF WARRANTY
469
470 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
471 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
472 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
473 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
474 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
475 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
476 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
477 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
478 NECESSARY SERVICING, REPAIR, OR CORRECTION.
479
480 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
481 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
482 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
483 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
484 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
485 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
486 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
487 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
488 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
489 SUCH DAMAGES.
This page took 0.075765 seconds and 3 git commands to generate.