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