commit 7b9a5b7eeb46882ff3bc9aa5a047a1d31cf7c087
Author: Lukas Thiemeier <lukast@cpan.org>
Date: Wed Apr 3 21:57:22 2013 +0200
Transform m2m data to recursive has_many data
if IntrospectableM2M is loaded
Removed "add_drop_table" in twopk_has_many.t and conditional_has_many.t
to get rid of the warnings.
diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
index 478d900..b8d2c4d 100644
--- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
+++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
@@ -8,28 +8,31 @@ package DBIx::Class::ResultSet::RecursiveUpdate;
use base qw(DBIx::Class::ResultSet);
sub recursive_update {
- my ( $self, $updates, $attrs ) = @_;
+ my ( $self, $updates, $attrs ) = @_;
- my $fixed_fields;
- my $unknown_params_ok;
+ my $fixed_fields;
+ my $unknown_params_ok;
+ my $m2m_force_set_rel;
- # 0.21+ api
- if ( defined $attrs && ref $attrs eq 'HASH' ) {
- $fixed_fields = $attrs->{fixed_fields};
- $unknown_params_ok = $attrs->{unknown_params_ok};
- }
+ # 0.21+ api
+ if ( defined $attrs && ref $attrs eq 'HASH' ) {
+ $fixed_fields = $attrs->{fixed_fields};
+ $unknown_params_ok = $attrs->{unknown_params_ok};
+ $m2m_force_set_rel = $attrs->{m2m_force_set_rel};
+ }
<snip>
- return DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update(
- resultset => $self,
- updates => $updates,
- fixed_fields => $fixed_fields,
- unknown_params_ok => $unknown_params_ok,
- );
+ return DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update(
+ resultset => $self,
+ updates => $updates,
+ fixed_fields => $fixed_fields,
+ unknown_params_ok => $unknown_params_ok,
+ m2m_force_set_rel => $m2m_force_set_rel,
+ );
}
package DBIx::Class::ResultSet::RecursiveUpdate::Functions;
@@ -39,411 +42,428 @@ use List::MoreUtils qw/ any all/;
use Try::Tiny;
- # relationships
- if ( $source->has_relationship($name) ) {
- if ( _master_relation_cond( $self, $name ) ) {
- $pre_updates{$name} = $updates->{$name};
- next;
- }
- else {
- $post_updates{$name} = $updates->{$name};
- next;
- }
- }
-
- # many-to-many helper accessors
- if ( is_m2m( $self, $name ) ) {
- $m2m_accessors{$name} = $updates->{$name};
- next;
- }
+ # columns
+ if ( exists $columns_by_accessor{$name} &&
+ !( $source->has_relationship($name) && ref( $updates->{$name} ) ) )
+ {
+ $columns{$name} = $updates->{$name};
+ next;
+ }
- # accessors
- if ( $object->can($name) && not $source->has_relationship($name) ) {
- $other_methods{$name} = $updates->{$name};
- next;
- }
+ # relationships
+ if ( $source->has_relationship($name) ) {
+ if ( _master_relation_cond( $self, $name ) ) {
+ $pre_updates{$name} = $updates->{$name};
+ next;
+ }
+ else {
+ $post_updates{$name} = $updates->{$name};
+ next;
+ }
+ }
- # unknown
+ # many-to-many helper accessors
+ if ( is_m2m( $self, $name ) ) {
+ # Transform m2m data into recursive has_many data
+ # if IntrospectableM2M is in use.
+ #
+ # This removes the overhead related to deleting and
+ # re-adding all relationships.
+ if ( ! $m2m_force_set_rel && $source->result_class->can('_m2m_metadata') ) {
+ my $meta = $source->result_class->_m2m_metadata->{$name};
+ my $bridge_rel = $meta->{relation};
+ my $foreign_rel = $meta->{foreign_relation};
+
+ $post_updates{$bridge_rel} = [ map { { $foreign_rel => $_ } } @{$updates->{$name}} ];
+ }
+ # Fall back to set_$rel if IntrospectableM2M
+ # is not available. (removing and re-adding all relationships)
+ else{
+ $m2m_accessors{$name} = $updates->{$name};
+ }
+
+ next;
+ }
- # don't throw a warning instead of an exception to give users
- # time to adapt to the new API
- carp(
- "No such column, relationship, many-to-many helper accessor or generic accessor '$name'"
- ) unless $unknown_params_ok;
+ # accessors
+ if ( $object->can($name) && not $source->has_relationship($name) ) {
+ $other_methods{$name} = $updates->{$name};
+ next;
+ }
- }
+ # unknown
- # first update columns and other accessors
- # so that later related records can be found
- for my $name ( keys %columns ) {
- $object->$name( $columns{$name} );
- }
- for my $name ( keys %other_methods ) {
- $object->$name( $other_methods{$name} );
- }
- for my $name ( keys %pre_updates ) {
- _update_relation( $self, $name, $pre_updates{$name}, $object, $if_not_submitted );
- }
+ # don't throw a warning instead of an exception to give users
+ # time to adapt to the new API
+ carp(
+ "No such column, relationship, many-to-many helper accessor or generic accessor '$name'"
+ ) unless $unknown_params_ok;
- # $self->_delete_empty_auto_increment($object);
- # don't allow insert to recurse to related objects
- # do the recursion ourselves
- # $object->{_rel_in_storage} = 1;
- # Update if %other_methods because of possible custom update method
- $object->update_or_insert if ( $object->is_changed || keys %other_methods );
- $object->discard_changes;
-
- # updating many_to_many
- for my $name ( keys %m2m_accessors ) {
- my $value = $m2m_accessors{$name};
-
- # TODO: only first pk col is used
- my ($pk) = _get_pk_for_related( $self, $name );
- my @rows;
- my $rel_source = $object->$name->result_source;
- my @updates;
- if ( defined $value && ref $value eq 'ARRAY' ) {
- @updates = @{$value};
}
- elsif ( defined $value && !ref $value ) {
- @updates = ($value);
+
+ # first update columns and other accessors
+ # so that later related records can be found
+ for my $name ( keys %columns ) {
+ $object->$name( $columns{$name} );
}
- elsif ( defined $value ) {
- carp "value of many-to-many rel '$name' must be an arrayref or scalar: $value";
+ for my $name ( keys %other_methods ) {
+ $object->$name( $other_methods{$name} );
}
- for my $elem (@updates) {
- if ( blessed($elem) && $elem->isa('DBIx::Class::Row') ) {
- push @rows, $elem;
- }
- elsif ( ref $elem eq 'HASH' ) {
- push @rows,
- recursive_update(
- resultset => $rel_source->resultset,
- updates => $elem
- );
- }
- else {
- push @rows, $rel_source->resultset->find( { $pk => $elem } );
- }
+ for my $name ( keys %pre_updates ) {
+ _update_relation( $self, $name, $pre_updates{$name}, $object, $if_not_submitted );
}
- my $set_meth = 'set_' . $name;
- $object->$set_meth( \@rows );
- }
- for my $name ( keys %post_updates ) {
+
+ # $self->_delete_empty_auto_increment($object);
+ # don't allow insert to recurse to related objects
+ # do the recursion ourselves
+ # $object->{_rel_in_storage} = 1;
+ # Update if %other_methods because of possible custom update method
+ $object->update_or_insert if ( $object->is_changed || keys %other_methods );
+ $object->discard_changes;
+
+ # updating many_to_many
+ for my $name ( keys %m2m_accessors ) {
+ my $value = $m2m_accessors{$name};
+
+ # TODO: only first pk col is used
+ my ($pk) = _get_pk_for_related( $self, $name );
+ my @rows;
+ my $rel_source = $object->$name->result_source;
+ my @updates;
+ if ( defined $value && ref $value eq 'ARRAY' ) {
+ @updates = @{$value};
+ }
+ elsif ( defined $value && !ref $value ) {
+ @updates = ($value);
+ }
+ elsif ( defined $value ) {
+ carp "value of many-to-many rel '$name' must be an arrayref or scalar: $value";
+ }
+ for my $elem (@updates) {
+ if ( blessed($elem) && $elem->isa('DBIx::Class::Row') ) {
+ push @rows, $elem;
+ }
+ elsif ( ref $elem eq 'HASH' ) {
+ push @rows,
+ recursive_update(
+ resultset => $rel_source->resultset,
+ updates => $elem
+ );
+ }
+ else {
+ push @rows, $rel_source->resultset->find( { $pk => $elem } );
+ }
+ }
+ my $set_meth = 'set_' . $name;
+ $object->$set_meth( \@rows );
+}
+for my $name ( keys %post_updates ) {
_update_relation( $self, $name, $post_updates{$name}, $object, $if_not_submitted );
- }
- delete $ENV{DBIC_NULLABLE_KEY_NOWARN};
- return $object;
+}
+delete $ENV{DBIC_NULLABLE_KEY_NOWARN};
+return $object;
}
# returns DBIx::Class::ResultSource::column_info as a hash indexed by column accessor || name
sub _get_columns_by_accessor {
- my $self = shift;
- my $source = $self->result_source;
- my %columns;
- for my $name ( $source->columns ) {
- my $info = $source->column_info($name);
- $info->{name} = $name;
- $columns{ $info->{accessor} || $name } = $info;
- }
- return %columns;
+ my $self = shift;
+ my $source = $self->result_source;
+ my %columns;
+ for my $name ( $source->columns ) {
+ my $info = $source->column_info($name);
+ $info->{name} = $name;
+ $columns{ $info->{accessor} || $name } = $info;
+ }
+ return %columns;
}
# Arguments: $rs, $name, $updates, $row, $if_not_submitted
sub _update_relation {
- my ( $self, $name, $updates, $object, $if_not_submitted ) = @_;
+ my ( $self, $name, $updates, $object, $if_not_submitted ) = @_;
- # this should never happen because we're checking the paramters passed to
- # recursive_update, but just to be sure...
- $object->throw_exception("No such relationship '$name'")
+ # this should never happen because we're checking the paramters passed to
+ # recursive_update, but just to be sure...
+ $object->throw_exception("No such relationship '$name'")
unless $object->has_relationship($name);
- my $info = $object->result_source->relationship_info($name);
+ my $info = $object->result_source->relationship_info($name);
- # get a related resultset without a condition
- my $related_resultset = $self->related_resultset($name)->result_source->resultset;
- my $resolved;
- if ( $self->result_source->can('_resolve_condition') ) {
- $resolved = $self->result_source->_resolve_condition( $info->{cond}, $name, $object );
- }
- else {
- $self->throw_exception("result_source must support _resolve_condition");
- }
+ # get a related resultset without a condition
+ my $related_resultset = $self->related_resultset($name)->result_source->resultset;
+ my $resolved;
+ if ( $self->result_source->can('_resolve_condition') ) {
+ $resolved = $self->result_source->_resolve_condition( $info->{cond}, $name, $object );
+ }
+ else {
+ $self->throw_exception("result_source must support _resolve_condition");
+ }
- $resolved = {}
+ $resolved = {}
if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION &&
- $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $resolved;
+ $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $resolved;
- my @rel_cols = keys %{ $info->{cond} };
- map { s/^foreign\.// } @rel_cols;
+ my @rel_cols = keys %{ $info->{cond} };
+ map { s/^foreign\.// } @rel_cols;
- # find out if all related columns are nullable
- my $all_fks_nullable = 1;
- for my $rel_col (@rel_cols) {
- $all_fks_nullable = 0
- unless $related_resultset->result_source->column_info($rel_col)->{is_nullable};
- }
+ # find out if all related columns are nullable
+ my $all_fks_nullable = 1;
+ for my $rel_col (@rel_cols) {
+ $all_fks_nullable = 0
+ unless $related_resultset->result_source->column_info($rel_col)->{is_nullable};
+ }
- $if_not_submitted = $all_fks_nullable ? 'set_to_null' : 'delete'
+ $if_not_submitted = $all_fks_nullable ? 'set_to_null' : 'delete'
unless defined $if_not_submitted;
- # the only valid datatype for a has_many rels is an arrayref
- if ( $info->{attrs}{accessor} eq 'multi' ) {
+ # the only valid datatype for a has_many rels is an arrayref
+ if ( $info->{attrs}{accessor} eq 'multi' ) {
- # handle undef like empty arrayref
- $updates = []
- unless defined $updates;
- $self->throw_exception("data for has_many relationship '$name' must be an arrayref")
- unless ref $updates eq 'ARRAY';
+ # handle undef like empty arrayref
+ $updates = []
+ unless defined $updates;
+ $self->throw_exception("data for has_many relationship '$name' must be an arrayref")
+ unless ref $updates eq 'ARRAY';
- my @updated_objs;
+ my @updated_objs;
- for my $sub_updates ( @{$updates} ) {
- my $sub_object = recursive_update(
- resultset => $related_resultset,
- updates => $sub_updates,
- resolved => $resolved
- );
+ for my $sub_updates ( @{$updates} ) {
+ my $sub_object = recursive_update(
+ resultset => $related_resultset,
+ updates => $sub_updates,
+ resolved => $resolved
+ );
- push @updated_objs, $sub_object;
- }
+ push @updated_objs, $sub_object;
+ }
- my @related_pks = $related_resultset->result_source->primary_columns;
+ my @related_pks = $related_resultset->result_source->primary_columns;
- my $rs_rel_delist = $object->$name;
+ my $rs_rel_delist = $object->$name;
- # foreign table has a single pk column
- if ( scalar @related_pks == 1 ) {
- $rs_rel_delist = $rs_rel_delist->search_rs(
- {
- $self->current_source_alias . "." .
- $related_pks[0] => { -not_in => [ map ( $_->id, @updated_objs ) ] }
+ # foreign table has a single pk column
+ if ( scalar @related_pks == 1 ) {
+ $rs_rel_delist = $rs_rel_delist->search_rs(
+ {
+ $self->current_source_alias . "." .
+ $related_pks[0] => { -not_in => [ map ( $_->id, @updated_objs ) ] }
+ }
+ );
}
- );
- }
-
- # foreign table has multiple pk columns
- else {
- my @cond;
- for my $obj (@updated_objs) {
- my %cond_for_obj;
- for my $col (@related_pks) {
- $cond_for_obj{ $self->current_source_alias . ".$col" } =
- $obj->get_column($col);
+ # foreign table has multiple pk columns
+ else {
+ my @cond;
+ for my $obj (@updated_objs) {
+ my %cond_for_obj;
+ for my $col (@related_pks) {
+ $cond_for_obj{ $self->current_source_alias . ".$col" } =
+ $obj->get_column($col);
+
+ }
+ push @cond, \%cond_for_obj;
}
- push @cond, \%cond_for_obj;
- }
- # only limit resultset if there are related rows left
- if ( scalar @cond ) {
- $rs_rel_delist = $rs_rel_delist->search_rs( { -not => [@cond] } );
- }
+ # only limit resultset if there are related rows left
+ if ( scalar @cond ) {
+ $rs_rel_delist = $rs_rel_delist->search_rs( { -not => [@cond] } );
+ }
}
if ( $if_not_submitted eq 'delete' ) {
- $rs_rel_delist->delete;
+ $rs_rel_delist->delete;
}
elsif ( $if_not_submitted eq 'set_to_null' ) {
- my %update = map { $_ => undef } @rel_cols;
- $rs_rel_delist->update( \%update );
- }
+ my %update = map { $_ => undef } @rel_cols;
+ $rs_rel_delist->update( \%update );
+}
}
elsif ( $info->{attrs}{accessor} eq 'single' ||
- $info->{attrs}{accessor} eq 'filter' )
+ $info->{attrs}{accessor} eq 'filter' )
{
- my $sub_object;
- if ( ref $updates ) {
- if ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) {
- $sub_object = $updates;
- }
- elsif ( $info->{attrs}{accessor} eq 'single' &&
- defined $object->$name )
- {
- $sub_object = recursive_update(
- resultset => $related_resultset,
- updates => $updates,
- object => $object->$name
- );
+ my $sub_object;
+ if ( ref $updates ) {
+ if ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) {
+ $sub_object = $updates;
+ }
+ elsif ( $info->{attrs}{accessor} eq 'single' &&
+ defined $object->$name )
+ {
+ $sub_object = recursive_update(
+ resultset => $related_resultset,
+ updates => $updates,
+ object => $object->$name
+ );
+ }
+ else {
+ $sub_object = recursive_update(
+ resultset => $related_resultset,
+ updates => $updates,
+ resolved => $resolved
+ );
+ }
}
else {
- $sub_object = recursive_update(
- resultset => $related_resultset,
- updates => $updates,
- resolved => $resolved
- );
+ $sub_object = $related_resultset->find($updates)
+ unless (
+ !$updates &&
+ ( exists $info->{attrs}{join_type} &&
+ $info->{attrs}{join_type} eq 'LEFT' )
+ );
}
- }
- else {
- $sub_object = $related_resultset->find($updates)
- unless (
- !$updates &&
- ( exists $info->{attrs}{join_type} &&
- $info->{attrs}{join_type} eq 'LEFT' )
- );
- }
- $object->set_from_related( $name, $sub_object )
+ $object->set_from_related( $name, $sub_object )
unless (
- !$sub_object &&
- !$updates &&
- ( exists $info->{attrs}{join_type} &&
- $info->{attrs}{join_type} eq 'LEFT' )
+ !$sub_object &&
+ !$updates &&
+ ( exists $info->{attrs}{join_type} &&
+ $info->{attrs}{join_type} eq 'LEFT' )
);
}
else {
- $self->throw_exception(
- "recursive_update doesn't now how to handle relationship '$name' with accessor " .
- $info->{attrs}{accessor} );
+ $self->throw_exception(
+ "recursive_update doesn't now how to handle relationship '$name' with accessor " .
+ $info->{attrs}{accessor} );
}
}
sub is_m2m {
- my ( $self, $relation ) = @_;
- my $rclass = $self->result_class;
+ my ( $self, $relation ) = @_;
+ my $rclass = $self->result_class;
- # DBIx::Class::IntrospectableM2M
- if ( $rclass->can('_m2m_metadata') ) {
- return $rclass->_m2m_metadata->{$relation};
- }
- my $object = $self->new_result( {} );
- if ( $object->can($relation) and
- !$self->result_source->has_relationship($relation) and
- $object->can( 'set_' . $relation ) )
- {
- return 1;
- }
- return;
+ # DBIx::Class::IntrospectableM2M
+ if ( $rclass->can('_m2m_metadata') ) {
+ return $rclass->_m2m_metadata->{$relation};
+ }
+ my $object = $self->new_result( {} );
+ if ( $object->can($relation) and
+ !$self->result_source->has_relationship($relation) and
+ $object->can( 'set_' . $relation ) )
+ {
+ return 1;
+ }
+ return;
}
sub get_m2m_source {
- my ( $self, $relation ) = @_;
- my $rclass = $self->result_class;
-
- # DBIx::Class::IntrospectableM2M
- if ( $rclass->can('_m2m_metadata') ) {
- return $self->result_source->related_source(
- $rclass->_m2m_metadata->{$relation}{relation} )
- ->related_source( $rclass->_m2m_metadata->{$relation}{foreign_relation} );
- }
- my $object = $self->new_result( {} );
- my $r = $object->$relation;
- return $r->result_source;
+ my ( $self, $relation ) = @_;
+ my $rclass = $self->result_class;
+
+ # DBIx::Class::IntrospectableM2M
+ if ( $rclass->can('_m2m_metadata') ) {
+ return $self->result_source->related_source(
+ $rclass->_m2m_metadata->{$relation}{relation} )
+ ->related_source( $rclass->_m2m_metadata->{$relation}{foreign_relation} );
+ }
+ my $object = $self->new_result( {} );
+ my $r = $object->$relation;
+ return $r->result_source;
}
sub _delete_empty_auto_increment {
- my ( $self, $object ) = @_;
- for my $col ( keys %{ $object->{_column_data} } ) {
- if (
- $object->result_source->column_info($col)->{is_auto_increment} and
- ( !defined $object->{_column_data}{$col} or
- $object->{_column_data}{$col} eq '' )
- )
- {
- delete $object->{_column_data}{$col};
+ my ( $self, $object ) = @_;
+ for my $col ( keys %{ $object->{_column_data} } ) {
+ if (
+ $object->result_source->column_info($col)->{is_auto_increment} and
+ ( !defined $object->{_column_data}{$col} or
+ $object->{_column_data}{$col} eq '' )
+ )
+ {
+ delete $object->{_column_data}{$col};
+ }
}
- }
}
sub _get_pk_for_related {
- my ( $self, $relation ) = @_;
- my $source;
- if ( $self->result_source->has_relationship($relation) ) {
- $source = $self->result_source->related_source($relation);
- }
+ my ( $self, $relation ) = @_;
+ my $source;
+ if ( $self->result_source->has_relationship($relation) ) {
+ $source = $self->result_source->related_source($relation);
+ }
- # many to many case
- if ( is_m2m( $self, $relation ) ) {
- $source = get_m2m_source( $self, $relation );
- }
- return $source->primary_columns;
+ # many to many case
+ if ( is_m2m( $self, $relation ) ) {
+ $source = get_m2m_source( $self, $relation );
+ }
+ return $source->primary_columns;
}
# This function determines whether a relationship should be done before or
@@ -452,51 +472,51 @@ sub _get_pk_for_related {
# relationships after: has_many, might_have and has_one
# true means before, false after
sub _master_relation_cond {
- my ( $self, $name ) = @_;
+ my ( $self, $name ) = @_;
- my $source = $self->result_source;
- my $info = $source->relationship_info($name);
+ my $source = $self->result_source;
+ my $info = $source->relationship_info($name);
- # has_many rels are always after
- return 0
+ # has_many rels are always after
+ return 0
if $info->{attrs}->{accessor} eq 'multi';
- my @foreign_ids = _get_pk_for_related( $self, $name );
+ my @foreign_ids = _get_pk_for_related( $self, $name );
- my $cond = $info->{cond};
+ my $cond = $info->{cond};
- sub _inner {
- my ( $source, $cond, @foreign_ids ) = @_;
+ sub _inner {
+ my ( $source, $cond, @foreign_ids ) = @_;
- while ( my ( $f_key, $col ) = each %{$cond} ) {
+ while ( my ( $f_key, $col ) = each %{$cond} ) {
- # might_have is not master
- $col =~ s/^self\.//;
- $f_key =~ s/^foreign\.//;
- if ( $source->column_info($col)->{is_auto_increment} ) {
+ # might_have is not master
+ $col =~ s/^self\.//;
+ $f_key =~ s/^foreign\.//;
+ if ( $source->column_info($col)->{is_auto_increment} ) {
+ return 0;
+ }
+ if ( any { $_ eq $f_key } @foreign_ids ) {
+ return 1;
+ }
+ }
return 0;
- }
- if ( any { $_ eq $f_key } @foreign_ids ) {
- return 1;
- }
}
- return 0;
- }
- if ( ref $cond eq 'HASH' ) {
- return _inner( $source, $cond, @foreign_ids );
- }
+ if ( ref $cond eq 'HASH' ) {
+ return _inner( $source, $cond, @foreign_ids );
+ }
- # arrayref of hashrefs
- elsif ( ref $cond eq 'ARRAY' ) {
- for my $new_cond (@$cond) {
- return _inner( $source, $new_cond, @foreign_ids );
+ # arrayref of hashrefs
+ elsif ( ref $cond eq 'ARRAY' ) {
+ for my $new_cond (@$cond) {
+ return _inner( $source, $new_cond, @foreign_ids );
+ }
}
- }
- else {
- $source->throw_exception( "unhandled relation condition " . ref($cond) );
- }
- return;
+ else {
+ $source->throw_exception( "unhandled relation condition " . ref($cond) );
+ }
+ return;
}
1;
@@ -735,6 +755,24 @@ of undef or an empty array, all existing related rows are unlinked.
When the array contains elements they are updated if they exist, created when
not and deleted if not included.
+RecursiveUpdate defaults to
+calling 'set_$rel' to update many-to-many relationships.
+See L<DBIx::Class::Relationship/many_to_many> for details.
+set_$rel effectively removes and re-adds all relationship data,
+even if the set of related items did not change at all.
+
+If L<DBIx::Class::IntrospectableM2M> is in use, RecursiveUpdate will
+look up the corresponding has_many relationship and use this to recursively
+update the many-to-many relationship.
+
+While both mechanisms have the same final result, deleting and re-adding
+all relationship data can have unwanted consequences if triggers or
+method modifiers are defined or logging modules like L<DBIx::Class::AuditLog>
+are in use.
+
+The traditional "set_$rel" behaviour can be forced by passing
+"m2m_force_set_rel => 1" to recursive_update.
+
See L</is_m2m> for many-to-many pseudo relationship detection.
Updating the relationship:
@@ -790,6 +828,15 @@ Clearing the relationship:
tags => [],
});
+Make sure that set_$rel used to update many-to-many relationships
+even if IntrospectableM2M is loaded:
+
+ my $dvd = $dvd_rs->recursive_update( {
+ id => 1,
+ tags => [1, 2],
+ },
+ { m2m_force_set_rel => 1 },
+ );
=head1 INTERFACE
diff --git a/t/conditional_has_many.t b/t/conditional_has_many.t
index 68aa35e..985a04f 100644
--- a/t/conditional_has_many.t
+++ b/t/conditional_has_many.t
@@ -12,7 +12,8 @@ my $schema = AnotherTestDB::OnePK::Schema->connect('dbi:SQLite:dbname=:memory:')
isa_ok $schema, 'DBIx::Class::Schema';
lives_ok( sub{
- $schema->deploy({add_drop_table => 1});
+ #$schema->deploy({add_drop_table => 1});
+ $schema->deploy();
$schema->populate('Item', [
[ qw/idcol/ ],
[ 1 ],
@@ -52,7 +53,8 @@ $schema = AnotherTestDB::TwoPK::Schema->connect('dbi:SQLite:dbname=:memory:');
isa_ok $schema, 'DBIx::Class::Schema';
lives_ok( sub{
- $schema->deploy({add_drop_table => 1});
+ #$schema->deploy({add_drop_table => 1});
+ $schema->deploy();
$schema->populate('Item', [
[ qw/idcol/ ],
[ 1 ],
diff --git a/t/lib/DebugObject.pm b/t/lib/DebugObject.pm
new file mode 100644
index 0000000..6be5608
--- /dev/null
+++ b/t/lib/DebugObject.pm
@@ -0,0 +1,33 @@
+
+package DebugObject;
+
+sub new {
+ my $class = shift;
+ return bless {messages => []}, $class;
+}
+
+sub print{
+ my ($self, @messages) = @_;
+ push @{$self->{messages}}, @messages;
+}
+
+sub clear{
+ $_[0]->{messages} = [];
+}
+
+sub grep_messages{
+ my ($self, $grep) = @_;
+ return grep { $_ =~ qr/$grep/ } @{$self->{messages}};
+}
+
+sub get_messages{
+ $_[0]->{messages};
+}
+
+
+sub count_messages{
+ my ($self, $grep) = @_;
+ return scalar( defined $grep ? $self->grep_messages($grep) : $self->get_messages);
+}
+
+1;
diff --git a/t/twopk_has_many.t b/t/twopk_has_many.t
index 003bcc6..564cf72 100644
--- a/t/twopk_has_many.t
+++ b/t/twopk_has_many.t
@@ -13,7 +13,7 @@ my $schema = TwoPkHasManyDB::Schema->connect('dbi:SQLite:dbname=:memory:');
isa_ok $schema, 'DBIx::Class::Schema';
lives_ok( sub{
- $schema->deploy({add_drop_table => 1});
+ $schema->deploy();
$schema->populate('Item', [
[ qw/id/ ],
[ 1 ],
diff --git a/t/update_introspectable_m2m.t b/t/update_introspectable_m2m.t
new file mode 100644
index 0000000..39dc864
--- /dev/null
+++ b/t/update_introspectable_m2m.t
@@ -0,0 +1,400 @@
+# Note:
+#
+# I am using DebugObject in t/lib to catch the DBIC debug output
+# and regexes to check the messages in order to find out what RU
+# realy did.
+#
+# I think that this is a bad Idea. If the queries produced by
+# DBIC change in the future, these tests might fail even though
+# DBIC and RU still behave the same.
+#
+# I currently have no better idea how to find out weather RU
+# called set_$rel for M2Ms or not.
+# (It shouldn't if IntrospectableM2M is in use)
+#
+# I prefered this solution over monkeypatching DBIC, which was my
+# second idea. Any hints are highly welcome!
+#
+# - lukast
+
+
+use strict;
+use warnings;
+
+use Test::More;
+use DBIx::Class::ResultSet::RecursiveUpdate;
+
+use lib 't/lib';
+use DBSchema;
+use DebugObject;
+
+my $schema = DBSchema->get_test_schema();
+my $storage = $schema->storage;
+isa_ok $schema, "DBIx::Class::Schema";
+isa_ok $storage, "DBIx::Class::Storage";
+
+my $dbic_trace = DebugObject->new;
+$storage->debug(1);
+$storage->debugfh($dbic_trace);
+
+my $dvd_rs = $schema->resultset('Dvd');
+my $tag_rs = $schema->resultset('Tag');
+
+ok $dvd_rs->result_class->can("_m2m_metadata"), "dvd-rs has m2m metadata";
+ok ! $tag_rs->result_class->can("_m2m_metadata"), "tag-rs has no m2m metadata";
+
+##############################################
+# testing m2m updates with IntrospectableM2M #
+##############################################
+
+my $dvd_item = $dvd_rs->first;
+
+
+#
+# adding one
+#
+
+my $tag_ids = [$dvd_item->tags_rs->get_column("id")->all];
+
+push @$tag_ids, 1;
+
+
+my %updates = (
+ id => $dvd_item->id,
+ tags => $tag_ids,
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok ! $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "add one: update did not remove all tags'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "add one: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 1, "add one: update executed one insert";
+
+is $dvd_item->tags_rs->count, 3, "add one: DVD item has 3 tags";
+
+#
+# removing one
+#
+
+shift @$tag_ids;
+
+%updates = (
+ id => $dvd_item->id,
+ tags => $tag_ids,
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok ! $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "remove one: update did not remove all tags'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "remove one: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 0, "remove one: update executed no insert";
+
+is $dvd_item->tags_rs->count, 2, "remove one: DVD item has 2 tags";
+
+
+#
+# adding recursive
+#
+
+#push @$tag_ids, ( 4, 5, 6 );
+
+%updates = (
+ id => $dvd_item->id,
+ tags => [
+ (map { { name => $_->name, id => $_->id } } $dvd_item->tags->all) ,
+ { name => "winnie" },
+ { name => "fanny" },
+ { name => "sammy" },
+ ],
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok ! $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "add several: update did not remove all tags'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "add several: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 3, "add several: update executed three inserts in dvdtag";
+is $dbic_trace->count_messages("^INSERT INTO tag "), 3, "add several: update executed three inserts in tag";
+
+is $dvd_item->tags_rs->count, 5, "add several: DVD item has 5 tags";
+
+#
+# updating recursive
+#
+
+#push @$tag_ids, ( 4, 5, 6 );
+
+%updates = (
+ id => $dvd_item->id,
+ tags => [
+ (map { { name => $_->name."_Changed", id => $_->id } } $dvd_item->tags->all) ,
+ ],
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok ! $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "add several: update did not remove all tags'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "add several: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 0, "add several: update executed no inserts in dvdtag";
+is $dbic_trace->count_messages("^UPDATE tag "), 5, "add several: update executed five updates in tag";
+
+is $dvd_item->tags_rs->count, 5, "add several: DVD item has 5 tags";
+
+
+#
+# updating and removing
+#
+
+
+%updates = (
+ id => $dvd_item->id,
+ tags => [
+ (map { { name => $_->name."More", id => $_->id } } $dvd_item->tags->all) ,
+ ],
+);
+
+$updates{tags} = [splice @{$updates{tags}}, 2, 3];
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok ! $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "add several: update did not remove all tags'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "add several: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 0, "add several: update executed no inserts in dvdtag";
+is $dbic_trace->count_messages("^UPDATE tag "), 3, "add several: update executed three updates in tag";
+
+is $dvd_item->tags_rs->count, 3, "add several: DVD item has 3 tags";
+
+
+#
+# updating and adding
+#
+
+
+%updates = (
+ id => $dvd_item->id,
+ tags => [
+ (map { { name => $_->name."More", id => $_->id } } $dvd_item->tags->all) ,
+ { name => "rob" },
+ { name => "bot" },
+ ],
+);
+
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok ! $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "add several: update did not remove all tags'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "add several: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 2, "add several: update executed two inserts in dvdtag";
+is $dbic_trace->count_messages("^UPDATE tag "), 3, "add several: update executed three updates in tag";
+
+is $dvd_item->tags_rs->count, 5, "add several: DVD item has 5 tags";
+
+
+#
+# removing several
+#
+
+$tag_ids = [4,5];
+%updates = (
+ id => $dvd_item->id,
+ tags => $tag_ids,
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok ! $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "remove several: update did not remove all tags'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "remove several: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 0, "remove several: update executed no insert";
+
+is $dvd_item->tags_rs->count, 2, "remove several: DVD item has 2 tags";
+
+
+#
+# empty arrayref
+#
+
+$tag_ids = [];
+%updates = (
+ id => $dvd_item->id,
+ tags => $tag_ids,
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates);
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "remove all: update did remove all tags'";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 0, "remove all: update executed no insert";
+
+is $dvd_item->tags_rs->count, 0, "remove all: DVD item has no tags";
+
+#
+# old set_$rel behaviour
+#
+
+$tag_ids = [2,4];
+%updates = (
+ id => $dvd_item->id,
+ tags => $tag_ids,
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates, {m2m_force_set_rel => 1});
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "remove several: update did remove all tags'";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 2, "remove several: update executed 2 insert";
+
+is $dvd_item->tags_rs->count, 2, "remove several: DVD item has 2 tags";
+
+# doint this 2 times to test identical behaviour
+$tag_ids = [2,4];
+%updates = (
+ id => $dvd_item->id,
+ tags => $tag_ids,
+);
+
+$dbic_trace->clear;
+
+$dvd_rs->recursive_update(\%updates, {m2m_force_set_rel => 1});
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( dvd = \? \)'), "remove several: update did remove all tags'";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 2, "remove several: update executed 2 insert";
+
+is $dvd_item->tags_rs->count, 2, "remove several: DVD item has 2 tags";
+
+#################################################
+# testing m2m updates without IntrospectableM2M #
+#################################################
+
+my $tag_item = $tag_rs->first;
+
+
+#
+# adding one
+#
+
+my $dvd_ids = [$tag_item->dvds_rs->get_column("dvd_id")->all];
+
+push @$dvd_ids, 1;
+
+
+%updates = (
+ id => $tag_item->id,
+ dvds => $dvd_ids,
+);
+
+$dbic_trace->clear;
+
+$tag_rs->recursive_update(\%updates);
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( tag = \? \)'), "add one: update did remove all dvds'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "add one: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 3, "add one: update executed three insert";
+
+is $tag_item->dvds_rs->count, 3, "add one: tag item has 3 dvds";
+
+#
+# removing one
+#
+
+shift @$dvd_ids;
+
+%updates = (
+ id => $tag_item->id,
+ dvds => $dvd_ids,
+);
+
+$dbic_trace->clear;
+
+$tag_rs->recursive_update(\%updates);
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( tag = \? \)'), "remove one: update did remove all dvds'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "remove one: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 2, "remove one: update executed two insert";
+
+is $tag_item->dvds_rs->count, 2, "remove one: tag item has 2 dvds";
+
+
+#
+# adding recursive
+#
+
+#push @$dvd_ids, ( 4, 5, 6 );
+
+%updates = (
+ id => $tag_item->id,
+ dvds => [
+ (map { { name => $_->name, id => $_->id } } $tag_item->dvds->all) ,
+ { name => "winnie", owner => 1 },
+ { name => "fanny" , owner => 1},
+ { name => "sammy" , owner => 1},
+ ],
+);
+
+$dbic_trace->clear;
+
+$tag_rs->recursive_update(\%updates);
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( tag = \? \)'), "add several: update did remove all dvds'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "add several: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 5, "add several: update executed five inserts in dvdtag";
+is $dbic_trace->count_messages("^INSERT INTO dvd "), 3, "add several: update executed three inserts in dvd";
+
+is $tag_item->dvds_rs->count, 5, "add several: tag item has 5 dvds";
+
+
+#
+# removing several
+#
+
+$dvd_ids = [3,5];
+%updates = (
+ id => $tag_item->id,
+ dvds => $dvd_ids,
+);
+
+$dbic_trace->clear;
+
+$tag_rs->recursive_update(\%updates);
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( tag = \? \)'), "remove several: update did remove all dvds'";
+is $dbic_trace->count_messages("^DELETE FROM dvdtag "), 1, "remove several: update executed one delete";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 2, "remove several: update executed two insert";
+
+is $tag_item->dvds_rs->count, 2, "remove several: tag item has 2 dvds";
+
+
+#
+# empty arrayref
+#
+
+$dvd_ids = [];
+%updates = (
+ id => $tag_item->id,
+ dvds => $dvd_ids,
+);
+
+$dbic_trace->clear;
+
+$tag_rs->recursive_update(\%updates);
+
+ok $dbic_trace->count_messages('^DELETE FROM dvdtag WHERE \( tag = \? \)'), "remove all: update did remove all dvds'";
+is $dbic_trace->count_messages("^INSERT INTO dvdtag "), 0, "remove all: update executed no insert";
+
+is $tag_item->dvds_rs->count, 0, "remove all: tag item has no dvds";
+
+done_testing;