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