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