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