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( ref $updates->{$name} ){
121 @updates = @{ $updates->{$name} };
124 @updates = ( $updates->{$name} );
126 for my $elem ( @updates ) {
128 push @rows, $result_source->resultset->find($elem);
132 $result_source->resultset->find( { $pk => $elem } );
135 my $set_meth = 'set_' . $name;
136 $object->$set_meth( \
@rows );
139 for my $name ( keys %post_updates ) {
140 my $info = $object->result_source->relationship_info($name);
141 _update_relation
( $self, $name, $updates, $object, $info );
146 sub _get_columns_by_accessor
{
148 my $source = $self->result_source;
150 for my $name ( $source->columns ) {
151 my $info = $source->column_info($name);
152 $info->{name
} = $name;
153 $columns{ $info->{accessor
} || $name } = $info;
158 sub _update_relation
{
159 my ( $self, $name, $updates, $object, $info ) = @_;
161 $self->related_resultset($name)->result_source->resultset;
163 $self->result_source->resolve_condition( $info->{cond
}, $name, $object );
165 # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
167 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
&& $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
== $resolved;
168 if ( ref $updates->{$name} eq 'ARRAY' ) {
169 for my $sub_updates ( @{ $updates->{$name} } ) {
170 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
172 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates );
176 my $sub_updates = $updates->{$name};
178 if( ref $sub_updates ){
179 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
180 # for might_have relationship
181 if( $info->{attrs
}{accessor
} eq 'single' && defined $object->$name ){
182 $sub_object = recursive_update
(
183 resultset
=> $related_result,
184 updates
=> $sub_updates,
185 object
=> $object->$name
190 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates );
193 elsif( ! ref $sub_updates ){
194 $sub_object = $related_result->find( $sub_updates );
196 $object->set_from_related( $name, $sub_object );
201 my ( $self, $relation ) = @_;
202 my $rclass = $self->result_class;
204 # DBIx::Class::IntrospectableM2M
205 if ( $rclass->can('_m2m_metadata') ) {
206 return $rclass->_m2m_metadata->{$relation};
208 my $object = $self->new( {} );
209 if ( $object->can($relation)
210 and !$self->result_source->has_relationship($relation)
211 and $object->can( 'set_' . $relation ) )
219 my ( $self, $relation ) = @_;
220 my $rclass = $self->result_class;
222 # DBIx::Class::IntrospectableM2M
223 if ( $rclass->can('_m2m_metadata') ) {
224 return $self->result_source->related_source(
225 $rclass->_m2m_metadata->{$relation}{relation
} )
227 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
229 my $object = $self->new( {} );
230 my $r = $object->$relation;
231 return $r->result_source;
234 sub _delete_empty_auto_increment
{
235 my ( $self, $object ) = @_;
236 for my $col ( keys %{ $object->{_column_data
} } ) {
238 $object->result_source->column_info($col)->{is_auto_increment
}
239 and ( !defined $object->{_column_data
}{$col}
240 or $object->{_column_data
}{$col} eq '' )
243 delete $object->{_column_data
}{$col};
248 sub _get_pk_for_related
{
249 my ( $self, $relation ) = @_;
251 if ( $self->result_source->has_relationship($relation) ) {
252 $result_source = $self->result_source->related_source($relation);
256 if ( is_m2m
($self, $relation) ) {
257 $result_source = get_m2m_source
($self, $relation);
259 return $result_source->primary_columns;
262 sub _master_relation_cond
{
263 my ( $source, $cond, @foreign_ids ) = @_;
264 my $foreign_ids_re = join '|', @foreign_ids;
265 if ( ref $cond eq 'HASH' ) {
266 for my $f_key ( keys %{$cond} ) {
268 # might_have is not master
269 my $col = $cond->{$f_key};
271 if ( $source->column_info($col)->{is_auto_increment
} ) {
274 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
279 elsif ( ref $cond eq 'ARRAY' ) {
280 for my $new_cond (@$cond) {
282 if _master_relation_cond
( $source, $new_cond, @foreign_ids );
288 1; # Magic true value required at end of module
293 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
298 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.004
303 The functional interface:
305 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
309 title => 'One Flew Over the Cuckoo's Nest'
316 As ResultSet subclass:
318 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
320 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
324 my $user = $user_rs->recursive_update( {
328 title => 'One Flew Over the Cuckoo's Nest'
336 This is still experimental. I've added a functional interface so that it can be used
337 in Form Processors and not require modification of the model.
339 You can feed the ->create method with a recursive datastructure and have the related records
340 created. Unfortunately you cannot do a similar thing with update_or_create - this module
341 tries to fill that void.
343 It is a base class for ResultSets providing just one method: recursive_update
344 which works just like update_or_create but can recursively update or create
345 data objects composed of multiple rows. All rows need to be identified by primary keys
346 - so you need to provide them in the update structure (unless they can be deduced from
347 the parent row - for example when you have a belongs_to relationship).
348 If not all colums comprising the primary key are specified - then a new row will be created,
349 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
353 If the resultset itself stores an assignement for the primary key,
356 my $restricted_rs = $user_rs->search( { id => 1 } );
358 then you need to inform recursive_update about additional predicate with a second argument:
360 my $user = $restricted_rs->recursive_update( {
363 title => 'One Flew Over the Cuckoo's Nest'
370 This will work with a new DBIC release.
372 For a many_to_many (pseudo) relation you can supply a list of primary keys
373 from the other table - and it will link the record at hand to those and
374 only those records identified by them. This is convenient for handling web
375 forms with check boxes (or a SELECT box with multiple choice) that let you
376 update such (pseudo) relations.
378 For a description how to set up base classes for ResultSets see load_namespaces
379 in DBIx::Class::Schema.
381 =head1 DESIGN CHOICES
383 =head2 Treatment of many to many pseudo relations
385 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
386 If it is not loaded in the ResultSource classes - then the code relies on the fact that:
387 if($object->can($name) and
388 !$object->result_source->has_relationship($name) and
389 $object->can( 'set_' . $name )
392 then $name must be a many to many pseudo relation. And that in a
393 similarly ugly was I find out what is the ResultSource of objects from
394 that many to many pseudo relation.
401 =head2 recursive_update
403 The method that does the work here.
407 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
408 (pseudo) relation on $self.
410 =head2 get_m2m_source
412 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
413 to many (pseudo) relation 'name' from $self.
419 =head1 CONFIGURATION AND ENVIRONMENT
421 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
427 =head1 INCOMPATIBILITIES
429 =for author to fill in:
434 =head1 BUGS AND LIMITATIONS
436 =for author to fill in:
438 No bugs have been reported.
440 Please report any bugs or feature requests to
441 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
442 L<http://rt.cpan.org>.
447 Zbigniew Lukasiak C<< <zby@cpan.org> >>
448 Influenced by code by Pedro Melo.
450 =head1 LICENCE AND COPYRIGHT
452 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
454 This module is free software; you can redistribute it and/or
455 modify it under the same terms as Perl itself. See L<perlartistic>.
458 =head1 DISCLAIMER OF WARRANTY
460 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
461 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
462 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
463 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
464 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
465 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
466 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
467 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
468 NECESSARY SERVICING, REPAIR, OR CORRECTION.
470 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
471 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
472 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
473 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
474 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
475 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
476 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
477 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
478 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF