4 package DBIx
::Class
::ResultSet
::RecursiveUpdate
;
6 # ABSTRACT: like update_or_create - but recursive
8 use base
qw(DBIx::Class::ResultSet);
10 sub recursive_update
{
11 my ( $self, $updates, $attrs ) = @_;
14 my $unknown_params_ok;
17 if ( defined $attrs && ref $attrs eq 'HASH' ) {
18 $fixed_fields = $attrs->{fixed_fields
};
19 $unknown_params_ok = $attrs->{unknown_params_ok
};
23 elsif ( defined $attrs && ref $attrs eq 'ARRAY' ) {
24 $fixed_fields = $attrs;
28 DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
::recursive_update
(
31 fixed_fields
=> $fixed_fields,
32 unknown_params_ok
=> $unknown_params_ok,
36 package DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
;
37 use Carp
::Clan qw
/^DBIx::Class|^HTML::FormHandler|^Try::Tiny/;
38 use Scalar
::Util
qw( blessed );
39 use List
::MoreUtils qw
/ any /;
41 sub recursive_update
{
43 my ( $self, $updates, $fixed_fields, $object, $resolved,
44 $if_not_submitted, $unknown_params_ok )
46 qw
/resultset updates fixed_fields object resolved if_not_submitted unknown_params_ok/
50 my $source = $self->result_source;
52 croak
"first parameter needs to be defined"
53 unless defined $updates;
55 croak
"first parameter needs to be a hashref"
56 unless ref($updates) eq 'HASH';
58 # warn 'entering: ' . $source->from();
59 croak
'fixed fields needs to be an arrayref'
60 if defined $fixed_fields && ref $fixed_fields ne 'ARRAY';
62 if ( blessed
($updates) && $updates->isa('DBIx::Class::Row') ) {
65 if ( exists $updates->{id
} ) {
67 # warn "finding object by id " . $updates->{id} . "\n";
68 $object = $self->find( $updates->{id
}, { key
=> 'primary' } );
70 # warn "object not found by id\n"
71 # unless defined $object;
74 my %fixed_fields = map { $_ => 1 } @$fixed_fields
77 grep { !exists $updates->{$_} && !exists $fixed_fields{$_} }
78 $source->primary_columns;
79 if ( !$object && !scalar @missing ) {
81 # warn 'finding by: ' . Dumper( $updates ); use Data::Dumper;
82 $object = $self->find( $updates, { key
=> 'primary' } );
84 $updates = { %$updates, %$resolved };
86 grep { !exists $resolved->{$_} } @missing;
87 if ( !$object && !scalar @missing ) {
89 # warn 'finding by +resolved: ' . Dumper( $updates ); use Data::Dumper;
90 $object = $self->find( $updates, { key
=> 'primary' } );
93 $object = $self->new( {} )
94 unless defined $object;
96 # warn Dumper( $updates ); use Data::Dumper;
97 # direct column accessors
100 # relations that that should be done before the row is inserted into the
101 # database like belongs_to
104 # relations that that should be done after the row is inserted into the
105 # database like has_many, might_have and has_one
109 my %columns_by_accessor = _get_columns_by_accessor
($self);
111 # warn 'resolved: ' . Dumper( $resolved );
112 # warn 'updates: ' . Dumper( $updates ); use Data::Dumper;
113 # warn 'columns: ' . Dumper( \%columns_by_accessor );
114 for my $name ( keys %$updates ) {
117 if ( exists $columns_by_accessor{$name}
118 && !( $source->has_relationship($name)
119 && ref( $updates->{$name} ) ) )
122 #warn "$name is a column\n";
123 $columns{$name} = $updates->{$name};
128 if ( $source->has_relationship($name) ) {
129 if ( _master_relation_cond
( $self, $name ) ) {
131 #warn "$name is a pre-update rel\n";
132 $pre_updates{$name} = $updates->{$name};
137 #warn "$name is a post-update rel\n";
138 $post_updates{$name} = $updates->{$name};
143 # many-to-many helper accessors
144 if ( is_m2m
( $self, $name ) ) {
146 #warn "$name is a many-to-many helper accessor\n";
147 $m2m_accessors{$name} = $updates->{$name};
152 if ( $object->can($name) && not $source->has_relationship($name) ) {
154 #warn "$name is an accessor";
155 $other_methods{$name} = $updates->{$name};
161 # don't throw a warning instead of an exception to give users
162 # time to adapt to the new API
164 "No such column, relationship, many-to-many helper accessor or generic accessor '$name'"
165 ) unless $unknown_params_ok;
167 #$self->throw_exception(
168 # "No such column, relationship, many-to-many helper accessor or generic accessor '$name'"
172 # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper;
174 # first update columns and other accessors
175 # so that later related records can be found
176 for my $name ( keys %columns ) {
178 #warn "update col $name\n";
179 $object->$name( $columns{$name} );
181 for my $name ( keys %other_methods ) {
183 #warn "update other $name\n";
184 $object->$name( $other_methods{$name} );
186 for my $name ( keys %pre_updates ) {
188 #warn "pre_update $name\n";
189 _update_relation
( $self, $name, $pre_updates{$name}, $object,
193 # $self->_delete_empty_auto_increment($object);
194 # don't allow insert to recurse to related objects
195 # do the recursion ourselves
196 # $object->{_rel_in_storage} = 1;
197 #warn "CHANGED: " . $object->is_changed . "\n";
198 #warn "IN STOR: " . $object->in_storage . "\n";
199 $object->update_or_insert if $object->is_changed;
200 $object->discard_changes;
202 # updating many_to_many
203 for my $name ( keys %m2m_accessors ) {
204 my $value = $m2m_accessors{$name};
206 #warn "update m2m $name\n";
207 # TODO: only first pk col is used
208 my ($pk) = _get_pk_for_related
( $self, $name );
210 my $result_source = $object->$name->result_source;
212 if ( defined $value && ref $value eq 'ARRAY' ) {
213 @updates = @{$value};
215 elsif ( defined $value && !ref $value ) {
219 carp
"value of many-to-many rel '$name' must be an arrayref or scalar";
221 for my $elem (@updates) {
222 if ( blessed
($elem) && $elem->isa('DBIx::Class::Row') ) {
225 elsif ( ref $elem eq 'HASH' ) {
228 resultset
=> $result_source->resultset,
234 $result_source->resultset->find( { $pk => $elem } );
237 my $set_meth = 'set_' . $name;
238 $object->$set_meth( \
@rows );
240 for my $name ( keys %post_updates ) {
242 #warn "post_update $name\n";
243 _update_relation
( $self, $name, $post_updates{$name}, $object,
249 # returns DBIx::Class::ResultSource::column_info as a hash indexed by column accessor || name
250 sub _get_columns_by_accessor
{
252 my $source = $self->result_source;
254 for my $name ( $source->columns ) {
255 my $info = $source->column_info($name);
256 $info->{name
} = $name;
257 $columns{ $info->{accessor
} || $name } = $info;
262 # Arguments: $rs, $name, $updates, $row, $if_not_submitted
263 sub _update_relation
{
264 my ( $self, $name, $updates, $object, $if_not_submitted ) = @_;
266 # this should never happen because we're checking the paramters passed to
267 # recursive_update, but just to be sure...
268 $object->throw_exception("No such relationship '$name'")
269 unless $object->has_relationship($name);
271 #warn "_update_relation $name: OBJ: " . ref($object) . "\n";
273 my $info = $object->result_source->relationship_info($name);
275 # get a related resultset without a condition
276 my $related_resultset =
277 $self->related_resultset($name)->result_source->resultset;
279 if ( $self->result_source->can('_resolve_condition') ) {
281 $self->result_source->_resolve_condition( $info->{cond
}, $name,
285 $self->throw_exception(
286 "result_source must support _resolve_condition");
289 # warn "$name resolved: " . Dumper( $resolved ); use Data::Dumper;
291 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
292 && $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
295 my @rel_cols = keys %{ $info->{cond
} };
296 map {s/^foreign\.//} @rel_cols;
298 #warn "REL_COLS: " . Dumper(@rel_cols); use Data::Dumper;
299 #my $rel_col_cnt = scalar @rel_cols;
301 # find out if all related columns are nullable
302 my $all_fks_nullable = 1;
303 for my $rel_col (@rel_cols) {
304 $all_fks_nullable = 0
305 unless $related_resultset->result_source->column_info($rel_col)
309 $if_not_submitted = $all_fks_nullable ? 'nullify' : 'delete'
310 unless defined $if_not_submitted;
312 #warn "\tNULLABLE: $all_fks_nullable ACTION: $if_not_submitted\n";
314 #warn "RELINFO for $name: " . Dumper($info); use Data::Dumper;
316 # the only valid datatype for a has_many rels is an arrayref
317 if ( $info->{attrs
}{accessor
} eq 'multi' ) {
319 # handle undef like empty arrayref
321 unless defined $updates;
322 $self->throw_exception(
323 "data for has_many relationship '$name' must be an arrayref")
324 unless ref $updates eq 'ARRAY';
328 #warn "\tupdating has_many rel '$name' ($rel_col_cnt columns cols)\n";
329 for my $sub_updates ( @{$updates} ) {
330 my $sub_object = recursive_update
(
331 resultset
=> $related_resultset,
332 updates
=> $sub_updates,
333 resolved
=> $resolved
336 push @updated_objs, $sub_object;
339 #warn "\tcreated and updated related rows\n";
341 my @related_pks = $related_resultset->result_source->primary_columns;
343 my $rs_rel_delist = $object->$name;
345 # foreign table has a single pk column
346 if ( scalar @related_pks == 1 ) {
347 $rs_rel_delist = $rs_rel_delist->search_rs(
349 { -not_in
=> [ map ( $_->id, @updated_objs ) ] }
354 # foreign table has multiple pk columns
357 for my $obj (@updated_objs) {
359 for my $col (@related_pks) {
360 $cond_for_obj{$col} = $obj->get_column($col);
362 push @cond, \
%cond_for_obj;
365 # only limit resultset if there are related rows left
366 if ( scalar @cond ) {
368 $rs_rel_delist->search_rs( { -not => [@cond] } );
372 #warn "\tCOND: " . Dumper(\%cond);
373 #my $rel_delist_cnt = $rs_rel_delist->count;
374 if ( $if_not_submitted eq 'delete' ) {
376 #warn "\tdeleting related rows: $rel_delist_cnt\n";
377 $rs_rel_delist->delete;
379 elsif ( $if_not_submitted eq 'set_to_null' ) {
381 #warn "\tnullifying related rows: $rel_delist_cnt\n";
382 my %update = map { $_ => undef } @rel_cols;
383 $rs_rel_delist->update( \
%update );
386 elsif ($info->{attrs
}{accessor
} eq 'single'
387 || $info->{attrs
}{accessor
} eq 'filter' )
390 #warn "\tupdating rel '$name': $if_not_submitted\n";
392 if ( ref $updates ) {
393 if ( blessed
($updates) && $updates->isa('DBIx::Class::Row') ) {
394 $sub_object = $updates;
397 # for might_have relationship
398 elsif ( $info->{attrs
}{accessor
} eq 'single'
399 && defined $object->$name )
401 $sub_object = recursive_update
(
402 resultset
=> $related_resultset,
404 object
=> $object->$name
408 $sub_object = recursive_update
(
409 resultset
=> $related_resultset,
411 resolved
=> $resolved
416 $sub_object = $related_resultset->find($updates)
419 && ( exists $info->{attrs
}{join_type
}
420 && $info->{attrs
}{join_type
} eq 'LEFT' )
423 $object->set_from_related( $name, $sub_object )
427 && ( exists $info->{attrs
}{join_type
}
428 && $info->{attrs
}{join_type
} eq 'LEFT' )
432 $self->throw_exception(
433 "recursive_update doesn't now how to handle relationship '$name' with accessor "
434 . $info->{attrs
}{accessor
} );
439 my ( $self, $relation ) = @_;
440 my $rclass = $self->result_class;
442 # DBIx::Class::IntrospectableM2M
443 if ( $rclass->can('_m2m_metadata') ) {
444 return $rclass->_m2m_metadata->{$relation};
446 my $object = $self->new( {} );
447 if ( $object->can($relation)
448 and !$self->result_source->has_relationship($relation)
449 and $object->can( 'set_' . $relation ) )
457 my ( $self, $relation ) = @_;
458 my $rclass = $self->result_class;
460 # DBIx::Class::IntrospectableM2M
461 if ( $rclass->can('_m2m_metadata') ) {
462 return $self->result_source->related_source(
463 $rclass->_m2m_metadata->{$relation}{relation
} )
465 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
467 my $object = $self->new( {} );
468 my $r = $object->$relation;
469 return $r->result_source;
472 sub _delete_empty_auto_increment
{
473 my ( $self, $object ) = @_;
474 for my $col ( keys %{ $object->{_column_data
} } ) {
475 if ($object->result_source->column_info($col)->{is_auto_increment
}
476 and ( !defined $object->{_column_data
}{$col}
477 or $object->{_column_data
}{$col} eq '' )
480 delete $object->{_column_data
}{$col};
485 sub _get_pk_for_related
{
486 my ( $self, $relation ) = @_;
488 if ( $self->result_source->has_relationship($relation) ) {
489 $result_source = $self->result_source->related_source($relation);
493 if ( is_m2m
( $self, $relation ) ) {
494 $result_source = get_m2m_source
( $self, $relation );
496 return $result_source->primary_columns;
499 # This function determines wheter a relationship should be done before or
500 # after the row is inserted into the database
501 # relationships before: belongs_to
502 # relationships after: has_many, might_have and has_one
503 # true means before, false after
504 sub _master_relation_cond
{
505 my ( $self, $name ) = @_;
507 my $source = $self->result_source;
508 my $info = $source->relationship_info($name);
510 #warn "INFO: " . Dumper($info) . "\n";
512 # has_many rels are always after
514 if $info->{attrs
}->{accessor
} eq 'multi';
516 my @foreign_ids = _get_pk_for_related
( $self, $name );
518 #warn "IDS: " . join(', ', @foreign_ids) . "\n";
520 my $cond = $info->{cond
};
523 my ( $source, $cond, @foreign_ids ) = @_;
525 while ( my ( $f_key, $col ) = each %{$cond} ) {
527 # might_have is not master
529 $f_key =~ s/^foreign\.//;
530 if ( $source->column_info($col)->{is_auto_increment
} ) {
533 if ( any
{ $_ eq $f_key } @foreign_ids ) {
540 if ( ref $cond eq 'HASH' ) {
541 return _inner
( $source, $cond, @foreign_ids );
544 # arrayref of hashrefs
545 elsif ( ref $cond eq 'ARRAY' ) {
546 for my $new_cond (@$cond) {
547 return _inner
( $source, $new_cond, @foreign_ids );
551 $source->throw_exception(
552 "unhandled relation condition " . ref($cond) );
557 1; # Magic true value required at end of module
562 # The functional interface:
564 my $schema = MyDB::Schema->connect();
565 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update(
566 resultset => $schema->resultset('User'),
571 title => "One Flew Over the Cuckoo's Nest"
575 unknown_params_ok => 1,
579 # As ResultSet subclass:
581 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
583 # in the Schema file (see t/lib/DBSchema.pm). Or appropriate 'use base' in the ResultSet classes.
585 my $user = $schema->resultset('User')->recursive_update({
589 title => "One Flew Over the Cuckoo's Nest"
593 unknown_params_ok => 1,
596 # You'll get a warning if you pass non-result specific data to
597 # recursive_update. See L</"Additional data in the updates hashref">
598 # for more information how to prevent this.
602 This is still experimental.
604 You can feed the ->create method of DBIx::Class with a recursive datastructure
605 and have the related records created. Unfortunately you cannot do a similar
606 thing with update_or_create. This module tries to fill that void until
607 L<DBIx::Class> has an api itself.
609 The functional interface can be used without modifications of the model,
610 for example by form processors like L<HTML::FormHandler::Model::DBIC>.
612 It is a base class for L<DBIx::Class::ResultSet>s providing the method
613 recursive_update which works just like update_or_create but can recursively
614 update or create result objects composed of multiple rows. All rows need to be
615 identified by primary keys so you need to provide them in the update structure
616 (unless they can be deduced from the parent row. For example a related row of
617 a belongs_to relationship). If any of the primary key columns are missing,
618 a new row will be created, with the expectation that the missing columns will
619 be filled by it (as in the case of auto_increment primary keys).
621 If the resultset itself stores an assignment for the primary key,
624 my $restricted_rs = $user_rs->search( { id => 1 } );
626 you need to inform recursive_update about the additional predicate with the fixed_fields attribute:
628 my $user = $restricted_rs->recursive_update( {
631 title => 'One Flew Over the Cuckoo's Nest'
636 fixed_fields => [ 'id' ],
640 For a many_to_many (pseudo) relation you can supply a list of primary keys
641 from the other table and it will link the record at hand to those and
642 only those records identified by them. This is convenient for handling web
643 forms with check boxes (or a select field with multiple choice) that lets you
644 update such (pseudo) relations.
646 For a description how to set up base classes for ResultSets see
647 L<DBIx::Class::Schema/load_namespaces>.
649 =head2 Additional data in the updates hashref
651 If you pass additional data to recursive_update which doesn't match a column
652 name, column accessor, relationship or many-to-many helper accessor, it will
653 throw a warning by default. To disable this behaviour you can set the
654 unknown_params_ok attribute to a true value.
656 The warning thrown is:
657 "No such column, relationship, many-to-many helper accessor or generic accessor '$key'"
659 When used by L<HTML::FormHandler::Model::DBIC> this can happen if you have
660 additional form fields that aren't relevant to the database but don't have the
661 noupdate attribute set to a true value.
663 NOTE: in a future version this behaviour will change and throw an exception
664 instead of a warning!
667 =head1 DESIGN CHOICES
669 Columns and relationships which are excluded from the updates hashref aren't
672 =head2 Treatment of belongs_to relations
674 In case the relationship is included but undefined in the updates hashref,
675 all columns forming the relationship will be set to null.
676 If not all of them are nullable, DBIx::Class will throw an error.
678 Updating the relationship:
680 my $dvd = $dvd_rs->recursive_update( {
685 Clearing the relationship (only works if cols are nullable!):
687 my $dvd = $dvd_rs->recursive_update( {
692 =head2 Treatment of might_have relationships
694 In case the relationship is included but undefined in the updates hashref,
695 all columns forming the relationship will be set to null.
697 Updating the relationship:
699 my $user = $user_rs->recursive_update( {
702 street => "101 Main Street",
708 Clearing the relationship:
710 my $user = $user_rs->recursive_update( {
715 =head2 Treatment of has_many relations
717 If a relationship key is included in the data structure with a value of undef
718 or an empty array, all existing related rows will be deleted, or their foreign
719 key columns will be set to null.
721 The exact behaviour depends on the nullability of the foreign key columns and
722 the value of the "if_not_submitted" parameter. The parameter defaults to
723 undefined which neither nullifies nor deletes.
725 When the array contains elements they are updated if they exist, created when
726 not and deleted if not included.
728 =head3 All foreign table columns are nullable
730 In this case recursive_update defaults to nullifying the foreign columns.
732 =head3 Not all foreign table columns are nullable
734 In this case recursive_update deletes the foreign rows.
736 Updating the relationship:
740 my $user = $user_rs->recursive_update( {
742 owned_dvds => [1, 2],
747 my $user = $user_rs->recursive_update( {
751 name => 'temp name 1',
754 name => 'temp name 2',
761 my $user = $user_rs->recursive_update( {
763 owned_dvds => [ $dvd1, $dvd2 ],
766 You can even mix them:
768 my $user = $user_rs->recursive_update( {
770 owned_dvds => [ 1, { id => 2 } ],
773 Clearing the relationship:
775 my $user = $user_rs->recursive_update( {
780 This is the same as passing an empty array:
782 my $user = $user_rs->recursive_update( {
787 =head2 Treatment of many-to-many pseudo relations
789 If a many-to-many accessor key is included in the data structure with a value
790 of undef or an empty array, all existing related rows are unlinked.
792 When the array contains elements they are updated if they exist, created when
793 not and deleted if not included.
795 See L</is_m2m> for many-to-many pseudo relationship detection.
797 Updating the relationship:
801 my $dvd = $dvd_rs->recursive_update( {
808 my $dvd = $dvd_rs->recursive_update( {
824 my $dvd = $dvd_rs->recursive_update( {
826 tags => [ $tag1, $tag2 ],
829 You can even mix them:
831 my $dvd = $dvd_rs->recursive_update( {
833 tags => [ 2, { id => 3 } ],
836 Clearing the relationship:
838 my $dvd = $dvd_rs->recursive_update( {
843 This is the same as passing an empty array:
845 my $dvd = $dvd_rs->recursive_update( {
855 =head2 recursive_update
857 The method that does the work here.
863 =item Arguments: $name
865 =item Return Value: true, if $name is a many to many pseudo-relationship
869 The function gets the information about m2m relations from
870 L<DBIx::Class::IntrospectableM2M>. If it isn't loaded in the ResultSource
871 class, the code relies on the fact:
873 if($object->can($name) and
874 !$object->result_source->has_relationship($name) and
875 $object->can( 'set_' . $name )
878 to identify a many to many pseudo relationship. In a similar ugly way the
879 ResultSource of that many to many pseudo relationship is detected.
881 So if you need many to many pseudo relationship support, it's strongly
882 recommended to load L<DBIx::Class::IntrospectableM2M> in your ResultSource
885 =head2 get_m2m_source
889 =item Arguments: $name
891 =item Return Value: $result_source
895 =head1 CONFIGURATION AND ENVIRONMENT
897 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
903 optional but recommended:
904 DBIx::Class::IntrospectableM2M
906 =head1 INCOMPATIBILITIES
911 =head1 BUGS AND LIMITATIONS
913 The list of reported bugs can be viewed at L<http://rt.cpan.org/Public/Dist/Display.html?Name=DBIx-Class-ResultSet-RecursiveUpdate>.
915 Please report any bugs or feature requests to
916 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
917 L<http://rt.cpan.org>.