1 package DBIx
::Class
::ResultSet
::RecursiveUpdate
;
3 use version
; $VERSION = qv
('0.0.1');
9 use base
qw(DBIx::Class::ResultSet);
11 sub recursive_update
{
12 my( $self, $updates ) = @_;
14 $object = $self->find( $updates, { key
=> 'primary' } ) || $self->new( {} );
16 for my $name ( keys %$updates ){
17 if($object->can($name)){
18 my $value = $updates->{$name};
20 # updating relations that that should be done before the row is inserted into the database
22 if( $object->result_source->has_relationship($name)
26 my $info = $object->result_source->relationship_info( $name );
27 if( $info and not $info->{attrs
}{accessor
} eq 'multi'
29 _master_relation_cond
( $object, $info->{cond
}, _get_pk_for_related
( $object, $name ) )
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 );
36 # columns and other accessors
37 elsif( $object->result_source->has_column($name)
39 !$object->can( 'set_' . $name )
41 $object->$name($value);
44 #warn Dumper($object->{_column_data}); use Data::Dumper;
46 _delete_empty_auto_increment
($object);
47 $object->update_or_insert;
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};
54 if($object->can($name) and
55 !$object->result_source->has_relationship($name) and
56 $object->can( 'set_' . $name )
58 my ( $pk ) = _get_pk_for_related
( $object, $name );
59 my @values = @{$updates->{$name}};
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 );
66 elsif( $object->result_source->has_relationship($name) ){
67 my $info = $object->result_source->relationship_info( $name );
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 );
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 );
84 sub _delete_empty_auto_increment
{
86 for my $col ( keys %{$object->{_column_data
}}){
87 if( $object->result_source->column_info( $col )->{is_auto_increment
}
89 ( ! defined $object->{_column_data
}{$col} or $object->{_column_data
}{$col} eq '' )
91 delete $object->{_column_data
}{$col}
96 sub _get_pk_for_related
{
97 my ( $object, $relation ) = @_;
99 my $rs = $object->result_source->resultset;
100 my $result_source = _get_related_source
( $rs, $relation );
101 return $result_source->primary_columns;
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 );
110 my $row = $rs->new({});
111 if ( $row->can( $name ) and $row->can( 'add_to_' . $name ) and $row->can( 'set_' . $name ) ){
113 return $r->result_source;
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};
126 if( $object->column_info( $col )->{is_auto_increment
} ){
129 if( $f_key =~ /^foreign\.$foreign_ids_re/ ){
133 }elsif ( ref $cond eq 'ARRAY' ){
134 for my $new_cond ( @$cond ) {
135 return 1 if _master_relation_cond
( $object, $new_cond, @foreign_ids );
141 # Module implementation here
144 1; # Magic true value required at end of module
149 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
154 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.0.1
159 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
161 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
165 =for author to fill in:
167 my $user = $user_rs->recursive_update( {
172 title => 'One Flew Over the Cuckoo's Nest'
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.
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.
200 For a description how to set up base classes for ResultSets see load_namespaces
201 in DBIx::Class::Schema.
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.
209 =for uthor to fill in:
213 =head2 recursive_update
215 The only method here.
220 =head1 CONFIGURATION AND ENVIRONMENT
222 =for author to fill in:
224 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
229 =for author to fill in:
236 =head1 INCOMPATIBILITIES
238 =for author to fill in:
243 =head1 BUGS AND LIMITATIONS
245 =for author to fill in:
247 No bugs have been reported.
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>.
256 Zbigniew Lukasiak C<< <zby@cpan.org> >>
257 Influenced by code by Pedro Melo.
259 =head1 LICENCE AND COPYRIGHT
261 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
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>.
267 =head1 DISCLAIMER OF WARRANTY
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.
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