3 package DBIx
::Class
::ResultSet
::RecursiveUpdate
;
5 use version
; our $VERSION = qv
('0.008');
7 use base
qw(DBIx::Class::ResultSet);
10 my ( $self, $updates, $fixed_fields ) = @_;
11 return DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
::recursive_update
(
14 fixed_fields
=> $fixed_fields
18 package DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
;
20 use Scalar
::Util
qw( blessed );
23 sub recursive_update
{
25 my ( $self, $updates, $fixed_fields, $object, $resolved ) = @params{ qw
/resultset updates fixed_fields object resolved/ };
27 # warn 'entering: ' . $self->result_source->from();
28 carp
'fixed fields needs to be an array ref' if $fixed_fields && ref($fixed_fields) ne 'ARRAY';
30 %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields;
31 if ( blessed
($updates) && $updates->isa('DBIx::Class::Row') ) {
34 if ( $updates->{id
} ){
35 $object = $self->find( $updates->{id
}, { key
=> 'primary' } );
38 grep { !exists $updates->{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;
39 if ( !$object && !scalar @missing ) {
40 $object = $self->find( $updates, { key
=> 'primary' } );
43 grep { !exists $resolved->{$_} } @missing;
44 if ( !$object && !scalar @missing ) {
45 $object = $self->find( \
%{ %$updates, %$resolved }, { key
=> 'primary' } );
47 $object ||= $self->new( {} );
48 # warn Dumper( $updates ); use Data::Dumper;
49 # direct column accessors
52 # relations that that should be done before the row is inserted into the database
56 # relations that that should be done after the row is inserted into the database
57 # like has_many and might_have
60 my %columns_by_accessor = _get_columns_by_accessor
( $self );
61 # warn 'resolved: ' . Dumper( $resolved );
62 $updates = { %$updates, %$resolved };
63 # warn 'updates: ' . Dumper( $updates ); use Data::Dumper;
64 # warn 'columns: ' . Dumper( \%columns_by_accessor );
65 for my $name ( keys %$updates ) {
66 my $source = $self->result_source;
67 if ( $columns_by_accessor{$name}
68 && !( $source->has_relationship($name) && ref( $updates->{$name} ) )
71 $columns{$name} = $updates->{$name};
74 if( !( $source->has_relationship($name) ) ){
75 $other_methods{$name} = $updates->{$name};
78 my $info = $source->relationship_info($name);
80 _master_relation_cond
(
81 $source, $info->{cond
}, _get_pk_for_related
( $self, $name)
85 $pre_updates{$name} = $updates->{$name};
88 $post_updates{$name} = $updates->{$name};
91 # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper;
93 # first update columns and other accessors - so that later related records can be found
94 for my $name ( keys %columns ) {
95 $object->$name( $columns{$name} );
97 for my $name ( keys %other_methods) {
98 $object->$name( $updates->{$name} ) if $object->can( $name );
100 for my $name ( keys %pre_updates ) {
101 my $info = $object->result_source->relationship_info($name);
102 _update_relation
( $self, $name, $updates, $object, $info );
104 # $self->_delete_empty_auto_increment($object);
105 # don't allow insert to recurse to related objects - we do the recursion ourselves
106 # $object->{_rel_in_storage} = 1;
108 $object->update_or_insert;
111 # updating many_to_many
112 for my $name ( keys %$updates ) {
113 next if exists $columns{$name};
114 my $value = $updates->{$name};
116 if ( is_m2m
( $self, $name) ) {
117 my ($pk) = _get_pk_for_related
( $self, $name);
119 my $result_source = $object->$name->result_source;
121 if( ! defined $value ){
125 @updates = @{ $value };
128 @updates = ( $value );
130 for my $elem ( @updates ) {
132 push @rows, $result_source->resultset->find($elem);
136 $result_source->resultset->find( { $pk => $elem } );
139 my $set_meth = 'set_' . $name;
140 $object->$set_meth( \
@rows );
143 for my $name ( keys %post_updates ) {
144 my $info = $object->result_source->relationship_info($name);
145 _update_relation
( $self, $name, $updates, $object, $info );
150 sub _get_columns_by_accessor
{
152 my $source = $self->result_source;
154 for my $name ( $source->columns ) {
155 my $info = $source->column_info($name);
156 $info->{name
} = $name;
157 $columns{ $info->{accessor
} || $name } = $info;
162 sub _update_relation
{
163 my ( $self, $name, $updates, $object, $info ) = @_;
165 $self->related_resultset($name)->result_source->resultset;
167 if( $self->result_source->can( '_resolve_condition' ) ){
168 $resolved = $self->result_source->_resolve_condition( $info->{cond
}, $name, $object );
171 $resolved = $self->result_source->resolve_condition( $info->{cond
}, $name, $object );
174 # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
176 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
&& $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
== $resolved;
177 if ( ref $updates->{$name} eq 'ARRAY' ) {
178 for my $sub_updates ( @{ $updates->{$name} } ) {
180 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates, resolved
=> $resolved );
184 my $sub_updates = $updates->{$name};
186 if( ref $sub_updates ){
187 # for might_have relationship
188 if( $info->{attrs
}{accessor
} eq 'single' && defined $object->$name ){
189 $sub_object = recursive_update
(
190 resultset
=> $related_result,
191 updates
=> $sub_updates,
192 object
=> $object->$name
197 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates, resolved
=> $resolved );
200 elsif( ! ref $sub_updates ){
201 $sub_object = $related_result->find( $sub_updates );
203 $object->set_from_related( $name, $sub_object );
208 my ( $self, $relation ) = @_;
209 my $rclass = $self->result_class;
211 # DBIx::Class::IntrospectableM2M
212 if ( $rclass->can('_m2m_metadata') ) {
213 return $rclass->_m2m_metadata->{$relation};
215 my $object = $self->new( {} );
216 if ( $object->can($relation)
217 and !$self->result_source->has_relationship($relation)
218 and $object->can( 'set_' . $relation ) )
226 my ( $self, $relation ) = @_;
227 my $rclass = $self->result_class;
229 # DBIx::Class::IntrospectableM2M
230 if ( $rclass->can('_m2m_metadata') ) {
231 return $self->result_source->related_source(
232 $rclass->_m2m_metadata->{$relation}{relation
} )
234 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
236 my $object = $self->new( {} );
237 my $r = $object->$relation;
238 return $r->result_source;
241 sub _delete_empty_auto_increment
{
242 my ( $self, $object ) = @_;
243 for my $col ( keys %{ $object->{_column_data
} } ) {
245 $object->result_source->column_info($col)->{is_auto_increment
}
246 and ( !defined $object->{_column_data
}{$col}
247 or $object->{_column_data
}{$col} eq '' )
250 delete $object->{_column_data
}{$col};
255 sub _get_pk_for_related
{
256 my ( $self, $relation ) = @_;
258 if ( $self->result_source->has_relationship($relation) ) {
259 $result_source = $self->result_source->related_source($relation);
263 if ( is_m2m
($self, $relation) ) {
264 $result_source = get_m2m_source
($self, $relation);
266 return $result_source->primary_columns;
269 sub _master_relation_cond
{
270 my ( $source, $cond, @foreign_ids ) = @_;
271 my $foreign_ids_re = join '|', @foreign_ids;
272 if ( ref $cond eq 'HASH' ) {
273 for my $f_key ( keys %{$cond} ) {
275 # might_have is not master
276 my $col = $cond->{$f_key};
278 if ( $source->column_info($col)->{is_auto_increment
} ) {
281 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
286 elsif ( ref $cond eq 'ARRAY' ) {
287 for my $new_cond (@$cond) {
289 if _master_relation_cond
( $source, $new_cond, @foreign_ids );
295 1; # Magic true value required at end of module
300 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
305 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.006
310 The functional interface:
312 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
313 resultset => $schema->resultset( 'Dvd' ),
318 title => 'One Flew Over the Cuckoo's Nest'
325 As ResultSet subclass:
327 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
329 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
333 my $user = $user_rs->recursive_update( {
337 title => 'One Flew Over the Cuckoo's Nest'
345 This is still experimental. I've added a functional interface so that it can be used
346 in Form Processors and not require modification of the model.
348 You can feed the ->create method with a recursive datastructure and have the related records
349 created. Unfortunately you cannot do a similar thing with update_or_create - this module
350 tries to fill that void.
352 It is a base class for ResultSets providing just one method: recursive_update
353 which works just like update_or_create but can recursively update or create
354 data objects composed of multiple rows. All rows need to be identified by primary keys
355 - so you need to provide them in the update structure (unless they can be deduced from
356 the parent row - for example when you have a belongs_to relationship).
357 If not all colums comprising the primary key are specified - then a new row will be created,
358 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
362 If the resultset itself stores an assignement for the primary key,
365 my $restricted_rs = $user_rs->search( { id => 1 } );
367 then you need to inform recursive_update about additional predicate with a second argument:
369 my $user = $restricted_rs->recursive_update( {
372 title => 'One Flew Over the Cuckoo's Nest'
379 This will work with a new DBIC release.
381 For a many_to_many (pseudo) relation you can supply a list of primary keys
382 from the other table - and it will link the record at hand to those and
383 only those records identified by them. This is convenient for handling web
384 forms with check boxes (or a SELECT box with multiple choice) that let you
385 update such (pseudo) relations.
387 For a description how to set up base classes for ResultSets see load_namespaces
388 in DBIx::Class::Schema.
390 =head1 DESIGN CHOICES
392 =head2 Treatment of many to many pseudo relations
394 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
395 If it is not loaded in the ResultSource classes - then the code relies on the fact that:
396 if($object->can($name) and
397 !$object->result_source->has_relationship($name) and
398 $object->can( 'set_' . $name )
401 then $name must be a many to many pseudo relation. And that in a
402 similarly ugly was I find out what is the ResultSource of objects from
403 that many to many pseudo relation.
410 =head2 recursive_update
412 The method that does the work here.
416 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
417 (pseudo) relation on $self.
419 =head2 get_m2m_source
421 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
422 to many (pseudo) relation 'name' from $self.
428 =head1 CONFIGURATION AND ENVIRONMENT
430 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
436 =head1 INCOMPATIBILITIES
438 =for author to fill in:
443 =head1 BUGS AND LIMITATIONS
445 =for author to fill in:
447 No bugs have been reported.
449 Please report any bugs or feature requests to
450 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
451 L<http://rt.cpan.org>.
456 Zbigniew Lukasiak C<< <zby@cpan.org> >>
457 Influenced by code by Pedro Melo.
459 =head1 LICENCE AND COPYRIGHT
461 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
463 This module is free software; you can redistribute it and/or
464 modify it under the same terms as Perl itself. See L<perlartistic>.
467 =head1 DISCLAIMER OF WARRANTY
469 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
470 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
471 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
472 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
473 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
474 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
475 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
476 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
477 NECESSARY SERVICING, REPAIR, OR CORRECTION.
479 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
480 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
481 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
482 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
483 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
484 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
485 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
486 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
487 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF