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