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