1 package DBIx
::Class
::ResultSet
::RecursiveUpdate
;
3 use version
; $VERSION = qv
('0.001');
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
}, $self->_get_pk_for_related( $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( $self->is_m2m( $name ) ) {
55 my ( $pk ) = $self->_get_pk_for_related( $name );
56 my @values = @{$updates->{$name}};
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 );
63 elsif( $object->result_source->has_relationship($name) ){
64 my $info = $object->result_source->relationship_info( $name );
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 );
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 );
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)
94 my( $self, $relation ) = @_;
95 my $object = $self->new({});
96 my $r = $object->$relation;
97 return $r->result_source;
101 sub _delete_empty_auto_increment
{
103 for my $col ( keys %{$object->{_column_data
}}){
104 if( $object->result_source->column_info( $col )->{is_auto_increment
}
106 ( ! defined $object->{_column_data
}{$col} or $object->{_column_data
}{$col} eq '' )
108 delete $object->{_column_data
}{$col}
113 sub _get_pk_for_related
{
114 my ( $self, $relation ) = @_;
117 if( $self->result_source->has_relationship( $relation ) ){
118 $result_source = $self->result_source->related_source( $relation );
121 if ( $self->is_m2m( $relation ) ) {
122 $result_source = $self->get_m2m_source( $relation );
124 return $result_source->primary_columns;
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};
135 if( $object->column_info( $col )->{is_auto_increment
} ){
138 if( $f_key =~ /^foreign\.$foreign_ids_re/ ){
142 }elsif ( ref $cond eq 'ARRAY' ){
143 for my $new_cond ( @$cond ) {
144 return 1 if _master_relation_cond
( $object, $new_cond, @foreign_ids );
150 # Module implementation here
153 1; # Magic true value required at end of module
158 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
163 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.0.1
168 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
170 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
174 my $user = $user_rs->recursive_update( {
179 title => 'One Flew Over the Cuckoo's Nest'
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.
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.
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.
207 For a description how to set up base classes for ResultSets see load_namespaces
208 in DBIx::Class::Schema.
210 The support for many to many pseudo relationships should be treated as prototype -
211 the DBIC author disagrees with the way I did it.
218 =head2 recursive_update
220 The method that does the work here.
224 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
225 (pseudo) relation on $self.
227 =head2 get_m2m_source
229 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
230 to many (pseudo) relation 'name' from $self.
236 =head1 CONFIGURATION AND ENVIRONMENT
238 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
244 =head1 INCOMPATIBILITIES
246 =for author to fill in:
251 =head1 BUGS AND LIMITATIONS
253 =for author to fill in:
255 No bugs have been reported.
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>.
264 Zbigniew Lukasiak C<< <zby@cpan.org> >>
265 Influenced by code by Pedro Melo.
267 =head1 LICENCE AND COPYRIGHT
269 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
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>.
275 =head1 DISCLAIMER OF WARRANTY
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.
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