4 package DBIx
::Class
::ResultSet
::RecursiveUpdate
;
6 our $VERSION = '0.013';
8 use base
qw(DBIx::Class::ResultSet);
10 sub recursive_update
{
11 my ( $self, $updates, $fixed_fields ) = @_;
13 DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
::recursive_update
(
16 fixed_fields
=> $fixed_fields
20 package DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
;
22 use Scalar
::Util
qw( blessed );
24 sub recursive_update
{
26 my ( $self, $updates, $fixed_fields, $object, $resolved,
29 qw
/resultset updates fixed_fields object resolved if_not_submitted/};
32 # warn 'entering: ' . $self->result_source->from();
33 carp
'fixed fields needs to be an array ref'
34 if $fixed_fields && ref($fixed_fields) ne 'ARRAY';
36 %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields;
37 if ( blessed
($updates) && $updates->isa('DBIx::Class::Row') ) {
40 if ( $updates->{id
} ) {
41 $object = $self->find( $updates->{id
}, { key
=> 'primary' } );
44 grep { !exists $updates->{$_} && !exists $fixed_fields{$_} }
45 $self->result_source->primary_columns;
46 if ( !$object && !scalar @missing ) {
48 # warn 'finding by: ' . Dumper( $updates ); use Data::Dumper;
49 $object = $self->find( $updates, { key
=> 'primary' } );
51 $updates = { %$updates, %$resolved };
53 grep { !exists $resolved->{$_} } @missing;
54 if ( !$object && !scalar @missing ) {
56 # warn 'finding by +resolved: ' . Dumper( $updates ); use Data::Dumper;
57 $object = $self->find( $updates, { key
=> 'primary' } );
59 $object ||= $self->new( {} );
61 # warn Dumper( $updates ); use Data::Dumper;
62 # direct column accessors
65 # relations that that should be done before the row is inserted into the
66 # database like belongs_to
69 # relations that that should be done after the row is inserted into the
70 # database like has_many, might_have and has_one
73 my %columns_by_accessor = _get_columns_by_accessor
($self);
75 # warn 'resolved: ' . Dumper( $resolved );
76 # warn 'updates: ' . Dumper( $updates ); use Data::Dumper;
77 # warn 'columns: ' . Dumper( \%columns_by_accessor );
78 for my $name ( keys %$updates ) {
79 my $source = $self->result_source;
80 if ( $columns_by_accessor{$name}
81 && !( $source->has_relationship($name)
82 && ref( $updates->{$name} ) ) )
84 $columns{$name} = $updates->{$name};
87 if ( !( $source->has_relationship($name) ) ) {
88 $other_methods{$name} = $updates->{$name};
91 my $info = $source->relationship_info($name);
92 if (_master_relation_cond
(
93 $source, $info->{cond
},
94 _get_pk_for_related
( $self, $name )
98 $pre_updates{$name} = $updates->{$name};
101 $post_updates{$name} = $updates->{$name};
105 # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper;
107 # first update columns and other accessors
108 # so that later related records can be found
109 for my $name ( keys %columns ) {
110 $object->$name( $columns{$name} );
112 for my $name ( keys %other_methods ) {
113 $object->$name( $updates->{$name} ) if $object->can($name);
115 for my $name ( keys %pre_updates ) {
116 _update_relation
( $self, $name, $updates->{$name}, $object,
120 # $self->_delete_empty_auto_increment($object);
121 # don't allow insert to recurse to related objects
122 # do the recursion ourselves
123 # $object->{_rel_in_storage} = 1;
124 $object->update_or_insert if $object->is_changed;
126 # updating many_to_many
127 for my $name ( keys %$updates ) {
128 next if exists $columns{$name};
129 my $value = $updates->{$name};
131 if ( is_m2m
( $self, $name ) ) {
132 my ($pk) = _get_pk_for_related
( $self, $name );
134 my $result_source = $object->$name->result_source;
136 if ( !defined $value ) {
139 elsif ( ref $value ) {
140 @updates = @{$value};
145 for my $elem (@updates) {
149 resultset
=> $result_source->resultset,
155 $result_source->resultset->find( { $pk => $elem } );
158 my $set_meth = 'set_' . $name;
159 $object->$set_meth( \
@rows );
162 for my $name ( keys %post_updates ) {
163 _update_relation
( $self, $name, $updates->{$name}, $object,
169 # returns DBIx::Class::ResultSource::column_info as a hash indexed by column accessor || name
170 sub _get_columns_by_accessor
{
172 my $source = $self->result_source;
174 for my $name ( $source->columns ) {
175 my $info = $source->column_info($name);
176 $info->{name
} = $name;
177 $columns{ $info->{accessor
} || $name } = $info;
182 # Arguments: $name, $updates, $object, $if_not_submitted
184 sub _update_relation
{
185 my ( $self, $name, $updates, $object, $if_not_submitted ) = @_;
186 my $info = $object->result_source->relationship_info($name);
188 # get a related resultset without a condition
189 my $related_resultset =
190 $self->related_resultset($name)->result_source->resultset;
192 if ( $self->result_source->can('_resolve_condition') ) {
194 $self->result_source->_resolve_condition( $info->{cond
}, $name,
199 $self->result_source->resolve_condition( $info->{cond
}, $name,
203 # warn "$name resolved: " . Dumper( $resolved ); use Data::Dumper;
205 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
206 && $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
209 # an arrayref is only valid for has_many rels
210 if ( ref $updates eq 'ARRAY' ) {
212 for my $sub_updates ( @{$updates} ) {
213 my $sub_object = recursive_update
(
214 resultset
=> $related_resultset,
215 updates
=> $sub_updates,
216 resolved
=> $resolved
218 push @updated_ids, $sub_object->id;
220 my @related_pks = $related_resultset->result_source->primary_columns;
221 if ( defined $if_not_submitted && $if_not_submitted eq 'delete' ) {
223 # only handles related result classes with single primary keys
224 if ( 1 == scalar @related_pks ) {
225 $object->$name->search(
226 { $related_pks[0] => { -not_in
=> \
@updated_ids } } )
230 elsif ( defined $if_not_submitted
231 && $if_not_submitted eq 'set_to_null' )
234 # only handles related result classes with single primary keys
235 if ( 1 == scalar @related_pks ) {
236 my @fk = keys %$resolved;
237 $object->$name->search(
238 { $related_pks[0] => { -not_in
=> \
@updated_ids } } )
239 ->update( { $fk[0] => undef } );
245 if ( ref $updates ) {
247 # for might_have relationship
248 if ( $info->{attrs
}{accessor
} eq 'single'
249 && defined $object->$name )
251 $sub_object = recursive_update
(
252 resultset
=> $related_resultset,
254 object
=> $object->$name
258 $sub_object = recursive_update
(
259 resultset
=> $related_resultset,
261 resolved
=> $resolved
265 elsif ( !ref $updates ) {
266 $sub_object = $related_resultset->find($updates)
269 && ( exists $info->{attrs
}{join_type
}
270 && $info->{attrs
}{join_type
} eq 'LEFT' )
273 $object->set_from_related( $name, $sub_object )
277 && ( exists $info->{attrs
}{join_type
}
278 && $info->{attrs
}{join_type
} eq 'LEFT' )
284 my ( $self, $relation ) = @_;
285 my $rclass = $self->result_class;
287 # DBIx::Class::IntrospectableM2M
288 if ( $rclass->can('_m2m_metadata') ) {
289 return $rclass->_m2m_metadata->{$relation};
291 my $object = $self->new( {} );
292 if ( $object->can($relation)
293 and !$self->result_source->has_relationship($relation)
294 and $object->can( 'set_' . $relation ) )
302 my ( $self, $relation ) = @_;
303 my $rclass = $self->result_class;
305 # DBIx::Class::IntrospectableM2M
306 if ( $rclass->can('_m2m_metadata') ) {
307 return $self->result_source->related_source(
308 $rclass->_m2m_metadata->{$relation}{relation
} )
310 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
312 my $object = $self->new( {} );
313 my $r = $object->$relation;
314 return $r->result_source;
317 sub _delete_empty_auto_increment
{
318 my ( $self, $object ) = @_;
319 for my $col ( keys %{ $object->{_column_data
} } ) {
320 if ($object->result_source->column_info($col)->{is_auto_increment
}
321 and ( !defined $object->{_column_data
}{$col}
322 or $object->{_column_data
}{$col} eq '' )
325 delete $object->{_column_data
}{$col};
330 sub _get_pk_for_related
{
331 my ( $self, $relation ) = @_;
333 if ( $self->result_source->has_relationship($relation) ) {
334 $result_source = $self->result_source->related_source($relation);
338 if ( is_m2m
( $self, $relation ) ) {
339 $result_source = get_m2m_source
( $self, $relation );
341 return $result_source->primary_columns;
344 # This function determines wheter a relationship should be done before or
345 # after the row is inserted into the database
346 # relationships before: belongs_to
347 # relationships after: has_many, might_have and has_one
348 sub _master_relation_cond
{
349 my ( $source, $cond, @foreign_ids ) = @_;
350 my $foreign_ids_re = join '|', @foreign_ids;
351 if ( ref $cond eq 'HASH' ) {
352 for my $f_key ( keys %{$cond} ) {
354 # might_have is not master
355 my $col = $cond->{$f_key};
357 if ( $source->column_info($col)->{is_auto_increment
} ) {
360 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
365 elsif ( ref $cond eq 'ARRAY' ) {
366 for my $new_cond (@$cond) {
367 return _master_relation_cond
( $source, $new_cond, @foreign_ids );
373 1; # Magic true value required at end of module
378 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
382 The functional interface:
384 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
385 resultset => $schema->resultset( 'Dvd' ),
390 title => 'One Flew Over the Cuckoo's Nest'
397 As ResultSet subclass:
399 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
401 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
405 my $user = $user_rs->recursive_update( {
409 title => 'One Flew Over the Cuckoo's Nest'
418 This is still experimental. I've added a functional interface so that it can be used
419 in Form Processors and not require modification of the model.
421 You can feed the ->create method with a recursive datastructure and have the related records
422 created. Unfortunately you cannot do a similar thing with update_or_create - this module
423 tries to fill that void.
425 It is a base class for ResultSets providing just one method: recursive_update
426 which works just like update_or_create but can recursively update or create
427 data objects composed of multiple rows. All rows need to be identified by primary keys
428 - so you need to provide them in the update structure (unless they can be deduced from
429 the parent row - for example when you have a belongs_to relationship).
430 If not all colums comprising the primary key are specified - then a new row will be created,
431 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
435 If the resultset itself stores an assignement for the primary key,
438 my $restricted_rs = $user_rs->search( { id => 1 } );
440 then you need to inform recursive_update about additional predicate with a second argument:
442 my $user = $restricted_rs->recursive_update( {
445 title => 'One Flew Over the Cuckoo's Nest'
452 This will work with a new DBIC release.
454 For a many_to_many (pseudo) relation you can supply a list of primary keys
455 from the other table - and it will link the record at hand to those and
456 only those records identified by them. This is convenient for handling web
457 forms with check boxes (or a SELECT box with multiple choice) that let you
458 update such (pseudo) relations.
460 For a description how to set up base classes for ResultSets see load_namespaces
461 in DBIx::Class::Schema.
463 =head1 DESIGN CHOICES
465 Columns and relationships which are excluded from the updates hashref aren't
468 =head2 Treatment of belongs_to relations
470 In case the relationship is included but undefined in the updates hashref,
471 all columns forming the relationship will be set to null.
472 If not all of them are nullable, DBIx::Class will throw an error.
474 Updating the relationship:
476 my $dvd = $dvd_rs->recursive_update( {
481 Clearing the relationship (only works if cols are nullable!):
483 my $dvd = $dvd_rs->recursive_update( {
488 =head2 Treatment of might_have relationships
490 In case the relationship is included but undefined in the updates hashref,
491 all columns forming the relationship will be set to null.
493 Updating the relationship:
495 my $user = $user_rs->recursive_update( {
498 street => "101 Main Street",
504 Clearing the relationship:
506 my $user = $user_rs->recursive_update( {
511 =head2 Treatment of has_many relations
513 If a relationship key is included in the data structure with a value of undef
514 or an empty array, all existing related rows will be deleted, or their foreign
515 key columns will be set to null.
517 The exact behaviour depends on the nullability of the foreign key columns and
518 the value of the "if_not_submitted" parameter. The parameter defaults to
519 undefined which neither nullifies nor deletes.
521 When the array contains elements they are updated if they exist, created when
522 not and deleted if not included.
524 =head3 All foreign table columns are nullable
526 In this case recursive_update defaults to nullifying the foreign columns.
528 =head3 Not all foreign table columns are nullable
530 In this case recursive_update deletes the foreign rows.
532 Updating the relationship:
536 my $dvd = $dvd_rs->recursive_update( {
543 my $dvd = $dvd_rs->recursive_update( {
561 You can even mix them:
563 my $dvd = $dvd_rs->recursive_update( {
565 tags => [ '2', { id => '3' } ],
568 Clearing the relationship:
570 my $dvd = $dvd_rs->recursive_update( {
575 This is the same as passing an empty array:
577 my $dvd = $dvd_rs->recursive_update( {
582 =head2 Treatment of many-to-many pseudo relations
584 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
585 If it isn't loaded in the ResultSource classes the code relies on the fact that:
587 if($object->can($name) and
588 !$object->result_source->has_relationship($name) and
589 $object->can( 'set_' . $name )
592 Then $name must be a many to many pseudo relation.
593 And that in a similarly ugly was I find out what is the ResultSource of
594 objects from that many to many pseudo relation.
601 =head2 recursive_update
603 The method that does the work here.
607 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
608 (pseudo) relation on $self.
610 =head2 get_m2m_source
612 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
613 to many (pseudo) relation 'name' from $self.
619 =head1 CONFIGURATION AND ENVIRONMENT
621 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
627 =head1 INCOMPATIBILITIES
632 =head1 BUGS AND LIMITATIONS
634 No bugs have been reported.
636 Please report any bugs or feature requests to
637 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
638 L<http://rt.cpan.org>.
643 Zbigniew Lukasiak C<< <zby@cpan.org> >>
644 Influenced by code by Pedro Melo.
646 =head1 LICENCE AND COPYRIGHT
648 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
650 This module is free software; you can redistribute it and/or
651 modify it under the same terms as Perl itself. See L<perlartistic>.
654 =head1 DISCLAIMER OF WARRANTY
656 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
657 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
658 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
659 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
660 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
661 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
662 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
663 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
664 NECESSARY SERVICING, REPAIR, OR CORRECTION.
666 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
667 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
668 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
669 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
670 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
671 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
672 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
673 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
674 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF