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,
198 # warn "$name resolved: " . Dumper( $resolved ); use Data::Dumper;
200 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
201 && $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
204 # an arrayref is only valid for has_many rels
205 if ( ref $updates eq 'ARRAY' ) {
207 for my $sub_updates ( @{$updates} ) {
208 my $sub_object = recursive_update
(
209 resultset
=> $related_resultset,
210 updates
=> $sub_updates,
211 resolved
=> $resolved
213 push @updated_ids, $sub_object->id;
215 my @related_pks = $related_resultset->result_source->primary_columns;
216 if ( defined $if_not_submitted && $if_not_submitted eq 'delete' ) {
218 # only handles related result classes with single primary keys
219 if ( 1 == scalar @related_pks ) {
220 $object->$name->search(
221 { $related_pks[0] => { -not_in
=> \
@updated_ids } } )
225 elsif ( defined $if_not_submitted
226 && $if_not_submitted eq 'set_to_null' )
229 # only handles related result classes with single primary keys
230 if ( 1 == scalar @related_pks ) {
231 my @fk = keys %$resolved;
232 $object->$name->search(
233 { $related_pks[0] => { -not_in
=> \
@updated_ids } } )
234 ->update( { $fk[0] => undef } );
240 if ( ref $updates ) {
242 # for might_have relationship
243 if ( $info->{attrs
}{accessor
} eq 'single'
244 && defined $object->$name )
246 $sub_object = recursive_update
(
247 resultset
=> $related_resultset,
249 object
=> $object->$name
253 $sub_object = recursive_update
(
254 resultset
=> $related_resultset,
256 resolved
=> $resolved
260 elsif ( !ref $updates ) {
261 $sub_object = $related_resultset->find($updates)
264 && ( exists $info->{attrs
}{join_type
}
265 && $info->{attrs
}{join_type
} eq 'LEFT' )
268 $object->set_from_related( $name, $sub_object )
272 && ( exists $info->{attrs
}{join_type
}
273 && $info->{attrs
}{join_type
} eq 'LEFT' )
279 my ( $self, $relation ) = @_;
280 my $rclass = $self->result_class;
282 # DBIx::Class::IntrospectableM2M
283 if ( $rclass->can('_m2m_metadata') ) {
284 return $rclass->_m2m_metadata->{$relation};
286 my $object = $self->new( {} );
287 if ( $object->can($relation)
288 and !$self->result_source->has_relationship($relation)
289 and $object->can( 'set_' . $relation ) )
297 my ( $self, $relation ) = @_;
298 my $rclass = $self->result_class;
300 # DBIx::Class::IntrospectableM2M
301 if ( $rclass->can('_m2m_metadata') ) {
302 return $self->result_source->related_source(
303 $rclass->_m2m_metadata->{$relation}{relation
} )
305 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
307 my $object = $self->new( {} );
308 my $r = $object->$relation;
309 return $r->result_source;
312 sub _delete_empty_auto_increment
{
313 my ( $self, $object ) = @_;
314 for my $col ( keys %{ $object->{_column_data
} } ) {
315 if ($object->result_source->column_info($col)->{is_auto_increment
}
316 and ( !defined $object->{_column_data
}{$col}
317 or $object->{_column_data
}{$col} eq '' )
320 delete $object->{_column_data
}{$col};
325 sub _get_pk_for_related
{
326 my ( $self, $relation ) = @_;
328 if ( $self->result_source->has_relationship($relation) ) {
329 $result_source = $self->result_source->related_source($relation);
333 if ( is_m2m
( $self, $relation ) ) {
334 $result_source = get_m2m_source
( $self, $relation );
336 return $result_source->primary_columns;
339 # This function determines wheter a relationship should be done before or
340 # after the row is inserted into the database
341 # relationships before: belongs_to
342 # relationships after: has_many, might_have and has_one
343 sub _master_relation_cond
{
344 my ( $source, $cond, @foreign_ids ) = @_;
345 my $foreign_ids_re = join '|', @foreign_ids;
346 if ( ref $cond eq 'HASH' ) {
347 for my $f_key ( keys %{$cond} ) {
349 # might_have is not master
350 my $col = $cond->{$f_key};
352 if ( $source->column_info($col)->{is_auto_increment
} ) {
355 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
360 elsif ( ref $cond eq 'ARRAY' ) {
361 for my $new_cond (@$cond) {
362 return _master_relation_cond
( $source, $new_cond, @foreign_ids );
368 1; # Magic true value required at end of module
373 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
377 The functional interface:
379 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
380 resultset => $schema->resultset( 'Dvd' ),
385 title => 'One Flew Over the Cuckoo's Nest'
392 As ResultSet subclass:
394 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
396 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
400 my $user = $user_rs->recursive_update( {
404 title => 'One Flew Over the Cuckoo's Nest'
413 This is still experimental. I've added a functional interface so that it can be used
414 in Form Processors and not require modification of the model.
416 You can feed the ->create method with a recursive datastructure and have the related records
417 created. Unfortunately you cannot do a similar thing with update_or_create - this module
418 tries to fill that void.
420 It is a base class for ResultSets providing just one method: recursive_update
421 which works just like update_or_create but can recursively update or create
422 data objects composed of multiple rows. All rows need to be identified by primary keys
423 - so you need to provide them in the update structure (unless they can be deduced from
424 the parent row - for example when you have a belongs_to relationship).
425 If not all colums comprising the primary key are specified - then a new row will be created,
426 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
430 If the resultset itself stores an assignement for the primary key,
433 my $restricted_rs = $user_rs->search( { id => 1 } );
435 then you need to inform recursive_update about additional predicate with a second argument:
437 my $user = $restricted_rs->recursive_update( {
440 title => 'One Flew Over the Cuckoo's Nest'
447 This will work with a new DBIC release.
449 For a many_to_many (pseudo) relation you can supply a list of primary keys
450 from the other table - and it will link the record at hand to those and
451 only those records identified by them. This is convenient for handling web
452 forms with check boxes (or a SELECT box with multiple choice) that let you
453 update such (pseudo) relations.
455 For a description how to set up base classes for ResultSets see load_namespaces
456 in DBIx::Class::Schema.
458 =head1 DESIGN CHOICES
460 Columns and relationships which are excluded from the updates hashref aren't
463 =head2 Treatment of belongs_to relations
465 In case the relationship is included but undefined in the updates hashref,
466 all columns forming the relationship will be set to null.
467 If not all of them are nullable, DBIx::Class will throw an error.
469 Updating the relationship:
471 my $dvd = $dvd_rs->recursive_update( {
476 Clearing the relationship (only works if cols are nullable!):
478 my $dvd = $dvd_rs->recursive_update( {
483 =head2 Treatment of might_have relationships
485 In case the relationship is included but undefined in the updates hashref,
486 all columns forming the relationship will be set to null.
488 Updating the relationship:
490 my $user = $user_rs->recursive_update( {
493 street => "101 Main Street",
499 Clearing the relationship:
501 my $user = $user_rs->recursive_update( {
506 =head2 Treatment of has_many relations
508 If a relationship key is included in the data structure with a value of undef
509 or an empty array, all existing related rows will be deleted, or their foreign
510 key columns will be set to null.
512 The exact behaviour depends on the nullability of the foreign key columns and
513 the value of the "if_not_submitted" parameter. The parameter defaults to
514 undefined which neither nullifies nor deletes.
516 When the array contains elements they are updated if they exist, created when
517 not and deleted if not included.
519 =head3 All foreign table columns are nullable
521 In this case recursive_update defaults to nullifying the foreign columns.
523 =head3 Not all foreign table columns are nullable
525 In this case recursive_update deletes the foreign rows.
527 Updating the relationship:
531 my $dvd = $dvd_rs->recursive_update( {
538 my $dvd = $dvd_rs->recursive_update( {
556 You can even mix them:
558 my $dvd = $dvd_rs->recursive_update( {
560 tags => [ '2', { id => '3' } ],
563 Clearing the relationship:
565 my $dvd = $dvd_rs->recursive_update( {
570 This is the same as passing an empty array:
572 my $dvd = $dvd_rs->recursive_update( {
577 =head2 Treatment of many-to-many pseudo relations
579 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
580 If it isn't loaded in the ResultSource classes the code relies on the fact that:
582 if($object->can($name) and
583 !$object->result_source->has_relationship($name) and
584 $object->can( 'set_' . $name )
587 Then $name must be a many to many pseudo relation.
588 And that in a similarly ugly was I find out what is the ResultSource of
589 objects from that many to many pseudo relation.
596 =head2 recursive_update
598 The method that does the work here.
602 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
603 (pseudo) relation on $self.
605 =head2 get_m2m_source
607 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
608 to many (pseudo) relation 'name' from $self.
614 =head1 CONFIGURATION AND ENVIRONMENT
616 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
622 =head1 INCOMPATIBILITIES
627 =head1 BUGS AND LIMITATIONS
629 No bugs have been reported.
631 Please report any bugs or feature requests to
632 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
633 L<http://rt.cpan.org>.
638 Zbigniew Lukasiak C<< <zby@cpan.org> >>
639 Influenced by code by Pedro Melo.
641 =head1 LICENCE AND COPYRIGHT
643 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
645 This module is free software; you can redistribute it and/or
646 modify it under the same terms as Perl itself. See L<perlartistic>.
649 =head1 DISCLAIMER OF WARRANTY
651 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
652 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
653 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
654 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
655 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
656 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
657 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
658 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
659 NECESSARY SERVICING, REPAIR, OR CORRECTION.
661 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
662 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
663 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
664 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
665 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
666 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
667 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
668 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
669 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF