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