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