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