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