Workaround not needed any more
[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.0.1');
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}, _get_pk_for_related( $object, $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 _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($object->can($name) and
55 !$object->result_source->has_relationship($name) and
56 $object->can( 'set_' . $name )
57 ) {
58 my ( $pk ) = _get_pk_for_related( $object, $name );
59 my @values = @{$updates->{$name}};
60 my @rows;
61 my $result_source = $object->$name->result_source;
62 @rows = $result_source->resultset->search({ $pk => [ @values ] } ) if @values;
63 my $set_meth = 'set_' . $name;
64 $object->$set_meth( \@rows );
65 }
66 elsif( $object->result_source->has_relationship($name) ){
67 my $info = $object->result_source->relationship_info( $name );
68 # has many case
69 if( ref $updates->{$name} eq 'ARRAY' ){
70 for my $sub_updates ( @{$updates->{$name}} ) {
71 my $sub_object = $object->search_related( $name )->recursive_update( $sub_updates );
72 }
73 }
74 # might_have and has_one case
75 elsif ( ! _master_relation_cond( $object, $info->{cond}, _get_pk_for_related( $object, $name ) ) ){
76 my $sub_object = $object->search_related( $name )->recursive_update( $value );
77 #$object->set_from_related( $name, $sub_object );
78 }
79 }
80 }
81 return $object;
82 }
83
84 sub _delete_empty_auto_increment {
85 my ( $object ) = @_;
86 for my $col ( keys %{$object->{_column_data}}){
87 if( $object->result_source->column_info( $col )->{is_auto_increment}
88 and
89 ( ! defined $object->{_column_data}{$col} or $object->{_column_data}{$col} eq '' )
90 ){
91 delete $object->{_column_data}{$col}
92 }
93 }
94 }
95
96 sub _get_pk_for_related {
97 my ( $object, $relation ) = @_;
98
99 my $rs = $object->result_source->resultset;
100 my $result_source = _get_related_source( $rs, $relation );
101 return $result_source->primary_columns;
102 }
103
104 sub _get_related_source {
105 my ( $rs, $name ) = @_;
106 if( $rs->result_source->has_relationship( $name ) ){
107 return $rs->result_source->related_source( $name );
108 }
109 # many to many case
110 my $row = $rs->new({});
111 if ( $row->can( $name ) and $row->can( 'add_to_' . $name ) and $row->can( 'set_' . $name ) ){
112 my $r = $row->$name;
113 return $r->result_source;
114 }
115 return;
116 }
117
118 sub _master_relation_cond {
119 my ( $object, $cond, @foreign_ids ) = @_;
120 my $foreign_ids_re = join '|', @foreign_ids;
121 if ( ref $cond eq 'HASH' ){
122 for my $f_key ( keys %{$cond} ) {
123 # might_have is not master
124 my $col = $cond->{$f_key};
125 $col =~ s/self\.//;
126 if( $object->column_info( $col )->{is_auto_increment} ){
127 return 0;
128 }
129 if( $f_key =~ /^foreign\.$foreign_ids_re/ ){
130 return 1;
131 }
132 }
133 }elsif ( ref $cond eq 'ARRAY' ){
134 for my $new_cond ( @$cond ) {
135 return 1 if _master_relation_cond( $object, $new_cond, @foreign_ids );
136 }
137 }
138 return;
139 }
140
141 # Module implementation here
142
143
144 1; # Magic true value required at end of module
145 __END__
146
147 =head1 NAME
148
149 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
150
151
152 =head1 VERSION
153
154 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.0.1
155
156
157 =head1 SYNOPSIS
158
159 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
160
161 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
162
163 Then:
164
165 =for author to fill in:
166
167 my $user = $user_rs->recursive_update( {
168 id => 1,
169 owned_dvds => [
170 {
171 id => undef,
172 title => 'One Flew Over the Cuckoo's Nest'
173 }
174 ]
175 }
176 );
177
178
179 =head1 DESCRIPTION
180
181 =for author to fill in:
182 You can feed the ->create method with a recursive datastructure and have the related records
183 created. Unfortunately you cannot do a similar thing with update_or_create - this module
184 tries to fill that void.
185 It is a base class for ResultSets providing just one method: recursive_update
186 which works just like update_or_create but can recursively update or create
187 data objects composed of multiple rows. All rows need to be identified by primary keys
188 - so you need to provide them in the update structure (unless they can be deduced from
189 the parent row - for example when you have a belongs_to relationship).
190 When creating new rows in a table with auto_increment primary keys you need to
191 put 'undef' for the key value - this is then removed
192 and a correct INSERT statement is generated.
193
194 For a many_to_many (pseudo) relation you can supply a list of primary keys
195 from the other table - and it will link the record at hand to those and
196 only those records identified by them. This is convenient for handling web
197 forms with check boxes (or a SELECT box with multiple choice) that let you
198 update such (pseudo) relations.
199
200 For a description how to set up base classes for ResultSets see load_namespaces
201 in DBIx::Class::Schema.
202
203 The support for many to many pseudo relationships should be treated as prototype -
204 the DBIC author disagrees with the way I did it.
205
206
207 =head1 INTERFACE
208
209 =for uthor to fill in:
210
211 =head1 METHODS
212
213 =head2 recursive_update
214
215 The only method here.
216
217 =head1 DIAGNOSTICS
218
219
220 =head1 CONFIGURATION AND ENVIRONMENT
221
222 =for author to fill in:
223
224 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
225
226
227 =head1 DEPENDENCIES
228
229 =for author to fill in:
230
231 DBIx::Class
232
233 None.
234
235
236 =head1 INCOMPATIBILITIES
237
238 =for author to fill in:
239
240 None reported.
241
242
243 =head1 BUGS AND LIMITATIONS
244
245 =for author to fill in:
246
247 No bugs have been reported.
248
249 Please report any bugs or feature requests to
250 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
251 L<http://rt.cpan.org>.
252
253
254 =head1 AUTHOR
255
256 Zbigniew Lukasiak C<< <zby@cpan.org> >>
257 Influenced by code by Pedro Melo.
258
259 =head1 LICENCE AND COPYRIGHT
260
261 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
262
263 This module is free software; you can redistribute it and/or
264 modify it under the same terms as Perl itself. See L<perlartistic>.
265
266
267 =head1 DISCLAIMER OF WARRANTY
268
269 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
270 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
271 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
272 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
273 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
274 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
275 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
276 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
277 NECESSARY SERVICING, REPAIR, OR CORRECTION.
278
279 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
280 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
281 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
282 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
283 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
284 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
285 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
286 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
287 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
288 SUCH DAMAGES.
This page took 0.054241 seconds and 4 git commands to generate.