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