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