1 package DBIx
::Class
::ResultSet
::RecursiveUpdate
;
3 use version
; $VERSION = qv
('0.001');
8 use Scalar
::Util
qw( blessed );
10 use base
qw(DBIx::Class::ResultSet);
12 sub recursive_update
{
13 my ( $self, $updates, $fixed_fields ) = @_;
14 # warn 'entering: ' . $self->result_source->from();
16 carp
'fixed fields needs to be an array ref' if $fixed_fields && ref($fixed_fields) ne 'ARRAY';
18 %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields;
20 if ( blessed
($updates) && $updates->isa('DBIx::Class::Row') ) {
25 # direct column accessors
28 # relations that that should be done before the row is inserted into the database
32 # relations that that should be done after the row is inserted into the database
33 # like has_many and might_have
35 my %columns_by_accessor = $self->_get_columns_by_accessor;
37 for my $name ( keys %$updates ) {
38 my $source = $self->result_source;
39 if ( $columns_by_accessor{$name}
40 && !( $source->has_relationship($name) && ref( $updates->{$name} ) )
43 $columns{$name} = $updates->{$name};
46 next if !$source->has_relationship($name);
47 my $info = $source->relationship_info($name);
49 _master_relation_cond
(
50 $source, $info->{cond
}, $self->_get_pk_for_related($name)
54 $pre_updates{$name} = $updates->{$name};
57 $post_updates{$name} = $updates->{$name};
60 # warn 'columns: ' . Dumper( \%columns ); use Data::Dumper;
64 grep { !exists $columns{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;
65 if ( !scalar @missing ) {
66 $object = $self->find( \
%columns, { key
=> 'primary' } );
68 $object ||= $self->new( {} );
70 # first update columns and other accessors - so that later related records can be found
71 for my $name ( keys %columns ) {
72 $object->$name( $updates->{$name} );
74 for my $name ( keys %pre_updates ) {
75 my $info = $object->result_source->relationship_info($name);
76 $self->_update_relation( $name, $updates, $object, $info );
78 $self->_delete_empty_auto_increment($object);
80 # don't allow insert to recurse to related objects - we do the recursion ourselves
81 # $object->{_rel_in_storage} = 1;
82 $object->update_or_insert;
84 # updating many_to_many
85 for my $name ( keys %$updates ) {
86 next if exists $columns{$name};
87 my $value = $updates->{$name};
89 if ( $self->is_m2m($name) ) {
90 my ($pk) = $self->_get_pk_for_related($name);
92 my $result_source = $object->$name->result_source;
93 for my $elem ( @{ $updates->{$name} } ) {
95 push @rows, $result_source->resultset->find($elem);
99 $result_source->resultset->find( { $pk => $elem } );
102 my $set_meth = 'set_' . $name;
103 $object->$set_meth( \
@rows );
106 for my $name ( keys %post_updates ) {
107 my $info = $object->result_source->relationship_info($name);
108 $self->_update_relation( $name, $updates, $object, $info );
113 sub _get_columns_by_accessor
{
115 my $source = $self->result_source;
117 for my $name ( $source->columns ) {
118 my $info = $source->column_info($name);
119 $info->{name
} = $name;
120 $columns{ $info->{accessor
} || $name } = $info;
125 sub _update_relation
{
126 my ( $self, $name, $updates, $object, $info ) = @_;
129 $self->related_resultset($name)->result_source->resultset;
131 $self->result_source->resolve_condition( $info->{cond
}, $name, $object );
133 # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
135 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
&& $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
== $resolved;
136 if ( ref $updates->{$name} eq 'ARRAY' ) {
137 for my $sub_updates ( @{ $updates->{$name} } ) {
138 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
140 $related_result->recursive_update( $sub_updates );
144 my $sub_updates = $updates->{$name};
145 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
147 $related_result->recursive_update( $sub_updates );
148 $object->set_from_related( $name, $sub_object );
153 my ( $self, $relation ) = @_;
154 my $rclass = $self->result_class;
156 # DBIx::Class::IntrospectableM2M
157 if ( $rclass->can('_m2m_metadata') ) {
158 return $rclass->_m2m_metadata->{$relation};
160 my $object = $self->new( {} );
161 if ( $object->can($relation)
162 and !$self->result_source->has_relationship($relation)
163 and $object->can( 'set_' . $relation ) )
171 my ( $self, $relation ) = @_;
172 my $rclass = $self->result_class;
174 # DBIx::Class::IntrospectableM2M
175 if ( $rclass->can('_m2m_metadata') ) {
176 return $self->result_source->related_source(
177 $rclass->_m2m_metadata->{$relation}{relation
} )
179 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
181 my $object = $self->new( {} );
182 my $r = $object->$relation;
183 return $r->result_source;
186 sub _delete_empty_auto_increment
{
187 my ( $self, $object ) = @_;
188 for my $col ( keys %{ $object->{_column_data
} } ) {
190 $object->result_source->column_info($col)->{is_auto_increment
}
191 and ( !defined $object->{_column_data
}{$col}
192 or $object->{_column_data
}{$col} eq '' )
195 delete $object->{_column_data
}{$col};
200 sub _get_pk_for_related
{
201 my ( $self, $relation ) = @_;
203 if ( $self->result_source->has_relationship($relation) ) {
204 $result_source = $self->result_source->related_source($relation);
208 if ( $self->is_m2m($relation) ) {
209 $result_source = $self->get_m2m_source($relation);
211 return $result_source->primary_columns;
214 sub _master_relation_cond
{
215 my ( $source, $cond, @foreign_ids ) = @_;
216 my $foreign_ids_re = join '|', @foreign_ids;
217 if ( ref $cond eq 'HASH' ) {
218 for my $f_key ( keys %{$cond} ) {
220 # might_have is not master
221 my $col = $cond->{$f_key};
223 if ( $source->column_info($col)->{is_auto_increment
} ) {
226 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
231 elsif ( ref $cond eq 'ARRAY' ) {
232 for my $new_cond (@$cond) {
234 if _master_relation_cond
( $source, $new_cond, @foreign_ids );
240 1; # Magic true value required at end of module
245 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
250 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.001
255 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
257 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
261 my $user = $user_rs->recursive_update( {
265 title => 'One Flew Over the Cuckoo's Nest'
274 You can feed the ->create method with a recursive datastructure and have the related records
275 created. Unfortunately you cannot do a similar thing with update_or_create - this module
276 tries to fill that void.
278 It is a base class for ResultSets providing just one method: recursive_update
279 which works just like update_or_create but can recursively update or create
280 data objects composed of multiple rows. All rows need to be identified by primary keys
281 - so you need to provide them in the update structure (unless they can be deduced from
282 the parent row - for example when you have a belongs_to relationship).
283 If not all colums comprising the primary key are specified - then a new row will be created,
284 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
288 If the resultset itself stores an assignement for the primary key,
291 my $restricted_rs = $user_rs->search( { id => 1 } );
293 then you need to inform recursive_update about additional predicate with a second argument:
295 my $user = $restricted_rs->recursive_update( {
298 title => 'One Flew Over the Cuckoo's Nest'
306 For a many_to_many (pseudo) relation you can supply a list of primary keys
307 from the other table - and it will link the record at hand to those and
308 only those records identified by them. This is convenient for handling web
309 forms with check boxes (or a SELECT box with multiple choice) that let you
310 update such (pseudo) relations.
312 For a description how to set up base classes for ResultSets see load_namespaces
313 in DBIx::Class::Schema.
315 =head1 DESIGN CHOICES
317 =head2 Treatment of many to many pseudo relations
319 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
320 If it is not loaded in the ResultSource classes - then the code relies on the fact that:
321 if($object->can($name) and
322 !$object->result_source->has_relationship($name) and
323 $object->can( 'set_' . $name )
326 then $name must be a many to many pseudo relation. And that in a
327 similarly ugly was I find out what is the ResultSource of objects from
328 that many to many pseudo relation.
335 =head2 recursive_update
337 The method that does the work here.
341 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
342 (pseudo) relation on $self.
344 =head2 get_m2m_source
346 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
347 to many (pseudo) relation 'name' from $self.
353 =head1 CONFIGURATION AND ENVIRONMENT
355 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
361 =head1 INCOMPATIBILITIES
363 =for author to fill in:
368 =head1 BUGS AND LIMITATIONS
370 =for author to fill in:
372 No bugs have been reported.
374 Please report any bugs or feature requests to
375 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
376 L<http://rt.cpan.org>.
381 Zbigniew Lukasiak C<< <zby@cpan.org> >>
382 Influenced by code by Pedro Melo.
384 =head1 LICENCE AND COPYRIGHT
386 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
388 This module is free software; you can redistribute it and/or
389 modify it under the same terms as Perl itself. See L<perlartistic>.
392 =head1 DISCLAIMER OF WARRANTY
394 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
395 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
396 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
397 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
398 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
399 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
400 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
401 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
402 NECESSARY SERVICING, REPAIR, OR CORRECTION.
404 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
405 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
406 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
407 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
408 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
409 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
410 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
411 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
412 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF