3 package DBIx
::Class
::ResultSet
::RecursiveUpdate
;
5 use version
; our $VERSION = qv
('0.005');
7 use base
qw(DBIx::Class::ResultSet);
10 my ( $self, $updates, $fixed_fields ) = @_;
11 return DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
::recursive_update
(
14 fixed_fields
=> $fixed_fields
18 package DBIx
::Class
::ResultSet
::RecursiveUpdate
::Functions
;
20 use Scalar
::Util
qw( blessed );
23 sub recursive_update
{
25 my ( $self, $updates, $fixed_fields, $object ) = @params{ qw
/resultset updates fixed_fields object/ };
26 # warn 'entering: ' . $self->result_source->from();
27 carp
'fixed fields needs to be an array ref' if $fixed_fields && ref($fixed_fields) ne 'ARRAY';
29 %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields;
30 if ( blessed
($updates) && $updates->isa('DBIx::Class::Row') ) {
33 # warn Dumper( $updates ); use Data::Dumper;
34 # direct column accessors
37 # relations that that should be done before the row is inserted into the database
41 # relations that that should be done after the row is inserted into the database
42 # like has_many and might_have
45 my %columns_by_accessor = _get_columns_by_accessor
( $self );
46 for my $name ( keys %$updates ) {
47 my $source = $self->result_source;
49 # && scalar @{$source->primary_columns} == 1
50 && !$source->has_column( 'id' )
52 my @ids = ( $updates->{id
} );
53 if( ref $updates->{id
} ){
54 @ids = @{ $updates->{id
} };
57 for my $key ( $source->primary_columns ){
58 $columns{ $key } = $ids[ $i++ ];
62 if ( $columns_by_accessor{$name}
63 && !( $source->has_relationship($name) && ref( $updates->{$name} ) )
66 $columns{$name} = $updates->{$name};
69 if( !( $source->has_relationship($name) ) ){
70 $other_methods{$name} = $updates->{$name};
73 my $info = $source->relationship_info($name);
75 _master_relation_cond
(
76 $source, $info->{cond
}, _get_pk_for_related
( $self, $name)
80 $pre_updates{$name} = $updates->{$name};
83 $post_updates{$name} = $updates->{$name};
86 # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper;
89 grep { !exists $columns{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;
90 if ( !$object && !scalar @missing ) {
91 $object = $self->find( \
%columns, { key
=> 'primary' } );
93 $object ||= $self->new( {} );
94 # first update columns and other accessors - so that later related records can be found
95 for my $name ( keys %columns ) {
96 $object->$name( $columns{$name} );
98 for my $name ( keys %other_methods) {
99 $object->$name( $updates->{$name} ) if $object->can( $name );
101 for my $name ( keys %pre_updates ) {
102 my $info = $object->result_source->relationship_info($name);
103 _update_relation
( $self, $name, $updates, $object, $info );
105 # $self->_delete_empty_auto_increment($object);
106 # don't allow insert to recurse to related objects - we do the recursion ourselves
107 # $object->{_rel_in_storage} = 1;
108 $object->update_or_insert;
110 # updating many_to_many
111 for my $name ( keys %$updates ) {
112 next if exists $columns{$name};
113 my $value = $updates->{$name};
115 if ( is_m2m
( $self, $name) ) {
116 my ($pk) = _get_pk_for_related
( $self, $name);
118 my $result_source = $object->$name->result_source;
120 if( ! defined $value ){
124 @updates = @{ $value };
127 @updates = ( $value );
129 for my $elem ( @updates ) {
131 push @rows, $result_source->resultset->find($elem);
135 $result_source->resultset->find( { $pk => $elem } );
138 my $set_meth = 'set_' . $name;
139 $object->$set_meth( \
@rows );
142 for my $name ( keys %post_updates ) {
143 my $info = $object->result_source->relationship_info($name);
144 _update_relation
( $self, $name, $updates, $object, $info );
149 sub _get_columns_by_accessor
{
151 my $source = $self->result_source;
153 for my $name ( $source->columns ) {
154 my $info = $source->column_info($name);
155 $info->{name
} = $name;
156 $columns{ $info->{accessor
} || $name } = $info;
161 sub _update_relation
{
162 my ( $self, $name, $updates, $object, $info ) = @_;
164 $self->related_resultset($name)->result_source->resultset;
166 $self->result_source->resolve_condition( $info->{cond
}, $name, $object );
168 # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
170 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
&& $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
== $resolved;
171 if ( ref $updates->{$name} eq 'ARRAY' ) {
172 for my $sub_updates ( @{ $updates->{$name} } ) {
173 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
175 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates );
179 my $sub_updates = $updates->{$name};
181 if( ref $sub_updates ){
182 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
183 # for might_have relationship
184 if( $info->{attrs
}{accessor
} eq 'single' && defined $object->$name ){
185 $sub_object = recursive_update
(
186 resultset
=> $related_result,
187 updates
=> $sub_updates,
188 object
=> $object->$name
193 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates );
196 elsif( ! ref $sub_updates ){
197 $sub_object = $related_result->find( $sub_updates );
199 $object->set_from_related( $name, $sub_object );
204 my ( $self, $relation ) = @_;
205 my $rclass = $self->result_class;
207 # DBIx::Class::IntrospectableM2M
208 if ( $rclass->can('_m2m_metadata') ) {
209 return $rclass->_m2m_metadata->{$relation};
211 my $object = $self->new( {} );
212 if ( $object->can($relation)
213 and !$self->result_source->has_relationship($relation)
214 and $object->can( 'set_' . $relation ) )
222 my ( $self, $relation ) = @_;
223 my $rclass = $self->result_class;
225 # DBIx::Class::IntrospectableM2M
226 if ( $rclass->can('_m2m_metadata') ) {
227 return $self->result_source->related_source(
228 $rclass->_m2m_metadata->{$relation}{relation
} )
230 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
232 my $object = $self->new( {} );
233 my $r = $object->$relation;
234 return $r->result_source;
237 sub _delete_empty_auto_increment
{
238 my ( $self, $object ) = @_;
239 for my $col ( keys %{ $object->{_column_data
} } ) {
241 $object->result_source->column_info($col)->{is_auto_increment
}
242 and ( !defined $object->{_column_data
}{$col}
243 or $object->{_column_data
}{$col} eq '' )
246 delete $object->{_column_data
}{$col};
251 sub _get_pk_for_related
{
252 my ( $self, $relation ) = @_;
254 if ( $self->result_source->has_relationship($relation) ) {
255 $result_source = $self->result_source->related_source($relation);
259 if ( is_m2m
($self, $relation) ) {
260 $result_source = get_m2m_source
($self, $relation);
262 return $result_source->primary_columns;
265 sub _master_relation_cond
{
266 my ( $source, $cond, @foreign_ids ) = @_;
267 my $foreign_ids_re = join '|', @foreign_ids;
268 if ( ref $cond eq 'HASH' ) {
269 for my $f_key ( keys %{$cond} ) {
271 # might_have is not master
272 my $col = $cond->{$f_key};
274 if ( $source->column_info($col)->{is_auto_increment
} ) {
277 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
282 elsif ( ref $cond eq 'ARRAY' ) {
283 for my $new_cond (@$cond) {
285 if _master_relation_cond
( $source, $new_cond, @foreign_ids );
291 1; # Magic true value required at end of module
296 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
301 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.004
306 The functional interface:
308 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
312 title => 'One Flew Over the Cuckoo's Nest'
319 As ResultSet subclass:
321 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
323 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
327 my $user = $user_rs->recursive_update( {
331 title => 'One Flew Over the Cuckoo's Nest'
339 This is still experimental. I've added a functional interface so that it can be used
340 in Form Processors and not require modification of the model.
342 You can feed the ->create method with a recursive datastructure and have the related records
343 created. Unfortunately you cannot do a similar thing with update_or_create - this module
344 tries to fill that void.
346 It is a base class for ResultSets providing just one method: recursive_update
347 which works just like update_or_create but can recursively update or create
348 data objects composed of multiple rows. All rows need to be identified by primary keys
349 - so you need to provide them in the update structure (unless they can be deduced from
350 the parent row - for example when you have a belongs_to relationship).
351 If not all colums comprising the primary key are specified - then a new row will be created,
352 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
356 If the resultset itself stores an assignement for the primary key,
359 my $restricted_rs = $user_rs->search( { id => 1 } );
361 then you need to inform recursive_update about additional predicate with a second argument:
363 my $user = $restricted_rs->recursive_update( {
366 title => 'One Flew Over the Cuckoo's Nest'
373 This will work with a new DBIC release.
375 For a many_to_many (pseudo) relation you can supply a list of primary keys
376 from the other table - and it will link the record at hand to those and
377 only those records identified by them. This is convenient for handling web
378 forms with check boxes (or a SELECT box with multiple choice) that let you
379 update such (pseudo) relations.
381 For a description how to set up base classes for ResultSets see load_namespaces
382 in DBIx::Class::Schema.
384 =head1 DESIGN CHOICES
386 =head2 Treatment of many to many pseudo relations
388 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
389 If it is not loaded in the ResultSource classes - then the code relies on the fact that:
390 if($object->can($name) and
391 !$object->result_source->has_relationship($name) and
392 $object->can( 'set_' . $name )
395 then $name must be a many to many pseudo relation. And that in a
396 similarly ugly was I find out what is the ResultSource of objects from
397 that many to many pseudo relation.
404 =head2 recursive_update
406 The method that does the work here.
410 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
411 (pseudo) relation on $self.
413 =head2 get_m2m_source
415 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
416 to many (pseudo) relation 'name' from $self.
422 =head1 CONFIGURATION AND ENVIRONMENT
424 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
430 =head1 INCOMPATIBILITIES
432 =for author to fill in:
437 =head1 BUGS AND LIMITATIONS
439 =for author to fill in:
441 No bugs have been reported.
443 Please report any bugs or feature requests to
444 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
445 L<http://rt.cpan.org>.
450 Zbigniew Lukasiak C<< <zby@cpan.org> >>
451 Influenced by code by Pedro Melo.
453 =head1 LICENCE AND COPYRIGHT
455 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
457 This module is free software; you can redistribute it and/or
458 modify it under the same terms as Perl itself. See L<perlartistic>.
461 =head1 DISCLAIMER OF WARRANTY
463 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
464 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
465 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
466 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
467 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
468 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
469 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
470 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
471 NECESSARY SERVICING, REPAIR, OR CORRECTION.
473 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
474 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
475 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
476 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
477 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
478 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
479 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
480 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
481 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF