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 # direct column accessors
36 # relations that that should be done before the row is inserted into the database
40 # relations that that should be done after the row is inserted into the database
41 # like has_many and might_have
44 my %columns_by_accessor = _get_columns_by_accessor
( $self );
46 for my $name ( keys %$updates ) {
47 my $source = $self->result_source;
48 if ( $columns_by_accessor{$name}
49 && !( $source->has_relationship($name) && ref( $updates->{$name} ) )
52 $columns{$name} = $updates->{$name};
55 if( !( $source->has_relationship($name) && ref( $updates->{$name} ) ) ){
56 $other_methods{$name} = $updates->{$name};
58 next if !$source->has_relationship($name);
59 my $info = $source->relationship_info($name);
61 _master_relation_cond
(
62 $source, $info->{cond
}, _get_pk_for_related
( $self, $name)
66 $pre_updates{$name} = $updates->{$name};
69 $post_updates{$name} = $updates->{$name};
72 # warn 'columns: ' . Dumper( \%columns ); use Data::Dumper;
75 grep { !exists $columns{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;
76 if ( !$object && !scalar @missing ) {
77 $object = $self->find( \
%columns, { key
=> 'primary' } );
79 $object ||= $self->new( {} );
81 # first update columns and other accessors - so that later related records can be found
82 for my $name ( keys %columns ) {
83 $object->$name( $updates->{$name} );
85 for my $name ( keys %other_methods) {
86 $object->$name( $updates->{$name} ) if $object->can( $name );
88 for my $name ( keys %pre_updates ) {
89 my $info = $object->result_source->relationship_info($name);
90 _update_relation
( $self, $name, $updates, $object, $info );
92 # $self->_delete_empty_auto_increment($object);
93 # don't allow insert to recurse to related objects - we do the recursion ourselves
94 # $object->{_rel_in_storage} = 1;
95 $object->update_or_insert;
97 # updating many_to_many
98 for my $name ( keys %$updates ) {
99 next if exists $columns{$name};
100 my $value = $updates->{$name};
102 if ( is_m2m
( $self, $name) ) {
103 my ($pk) = _get_pk_for_related
( $self, $name);
105 my $result_source = $object->$name->result_source;
106 for my $elem ( @{ $updates->{$name} } ) {
108 push @rows, $result_source->resultset->find($elem);
112 $result_source->resultset->find( { $pk => $elem } );
115 my $set_meth = 'set_' . $name;
116 $object->$set_meth( \
@rows );
119 for my $name ( keys %post_updates ) {
120 my $info = $object->result_source->relationship_info($name);
121 _update_relation
( $self, $name, $updates, $object, $info );
126 sub _get_columns_by_accessor
{
128 my $source = $self->result_source;
130 for my $name ( $source->columns ) {
131 my $info = $source->column_info($name);
132 $info->{name
} = $name;
133 $columns{ $info->{accessor
} || $name } = $info;
138 sub _update_relation
{
139 my ( $self, $name, $updates, $object, $info ) = @_;
141 $self->related_resultset($name)->result_source->resultset;
143 $self->result_source->resolve_condition( $info->{cond
}, $name, $object );
145 # warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
147 if defined $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
&& $DBIx::Class
::ResultSource
::UNRESOLVABLE_CONDITION
== $resolved;
148 if ( ref $updates->{$name} eq 'ARRAY' ) {
149 for my $sub_updates ( @{ $updates->{$name} } ) {
150 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
152 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates );
156 my $sub_updates = $updates->{$name};
157 $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
159 if( $info->{attrs
}{accessor
} eq 'single' && defined $object->$name ){
160 $sub_object = recursive_update
(
161 resultset
=> $related_result,
162 updates
=> $sub_updates,
163 object
=> $object->$name
168 recursive_update
( resultset
=> $related_result, updates
=> $sub_updates );
170 $object->set_from_related( $name, $sub_object );
175 my ( $self, $relation ) = @_;
176 my $rclass = $self->result_class;
178 # DBIx::Class::IntrospectableM2M
179 if ( $rclass->can('_m2m_metadata') ) {
180 return $rclass->_m2m_metadata->{$relation};
182 my $object = $self->new( {} );
183 if ( $object->can($relation)
184 and !$self->result_source->has_relationship($relation)
185 and $object->can( 'set_' . $relation ) )
193 my ( $self, $relation ) = @_;
194 my $rclass = $self->result_class;
196 # DBIx::Class::IntrospectableM2M
197 if ( $rclass->can('_m2m_metadata') ) {
198 return $self->result_source->related_source(
199 $rclass->_m2m_metadata->{$relation}{relation
} )
201 $rclass->_m2m_metadata->{$relation}{foreign_relation
} );
203 my $object = $self->new( {} );
204 my $r = $object->$relation;
205 return $r->result_source;
208 sub _delete_empty_auto_increment
{
209 my ( $self, $object ) = @_;
210 for my $col ( keys %{ $object->{_column_data
} } ) {
212 $object->result_source->column_info($col)->{is_auto_increment
}
213 and ( !defined $object->{_column_data
}{$col}
214 or $object->{_column_data
}{$col} eq '' )
217 delete $object->{_column_data
}{$col};
222 sub _get_pk_for_related
{
223 my ( $self, $relation ) = @_;
225 if ( $self->result_source->has_relationship($relation) ) {
226 $result_source = $self->result_source->related_source($relation);
230 if ( is_m2m
($self, $relation) ) {
231 $result_source = get_m2m_source
($self, $relation);
233 return $result_source->primary_columns;
236 sub _master_relation_cond
{
237 my ( $source, $cond, @foreign_ids ) = @_;
238 my $foreign_ids_re = join '|', @foreign_ids;
239 if ( ref $cond eq 'HASH' ) {
240 for my $f_key ( keys %{$cond} ) {
242 # might_have is not master
243 my $col = $cond->{$f_key};
245 if ( $source->column_info($col)->{is_auto_increment
} ) {
248 if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) {
253 elsif ( ref $cond eq 'ARRAY' ) {
254 for my $new_cond (@$cond) {
256 if _master_relation_cond
( $source, $new_cond, @foreign_ids );
262 1; # Magic true value required at end of module
267 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
272 This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.004
277 The functional interface:
279 my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({
283 title => 'One Flew Over the Cuckoo's Nest'
290 As ResultSet subclass:
292 __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' );
294 in the Schema file (see t/lib/DBSchema.pm). Or appriopriate 'use base' in the ResultSet classes.
298 my $user = $user_rs->recursive_update( {
302 title => 'One Flew Over the Cuckoo's Nest'
310 This is still experimental. I've added a functional interface so that it can be used
311 in Form Processors and not require modification of the model.
313 You can feed the ->create method with a recursive datastructure and have the related records
314 created. Unfortunately you cannot do a similar thing with update_or_create - this module
315 tries to fill that void.
317 It is a base class for ResultSets providing just one method: recursive_update
318 which works just like update_or_create but can recursively update or create
319 data objects composed of multiple rows. All rows need to be identified by primary keys
320 - so you need to provide them in the update structure (unless they can be deduced from
321 the parent row - for example when you have a belongs_to relationship).
322 If not all colums comprising the primary key are specified - then a new row will be created,
323 with the expectation that the missing columns will be filled by it (as in the case of auto_increment
327 If the resultset itself stores an assignement for the primary key,
330 my $restricted_rs = $user_rs->search( { id => 1 } );
332 then you need to inform recursive_update about additional predicate with a second argument:
334 my $user = $restricted_rs->recursive_update( {
337 title => 'One Flew Over the Cuckoo's Nest'
344 This will work with a new DBIC release.
346 For a many_to_many (pseudo) relation you can supply a list of primary keys
347 from the other table - and it will link the record at hand to those and
348 only those records identified by them. This is convenient for handling web
349 forms with check boxes (or a SELECT box with multiple choice) that let you
350 update such (pseudo) relations.
352 For a description how to set up base classes for ResultSets see load_namespaces
353 in DBIx::Class::Schema.
355 =head1 DESIGN CHOICES
357 =head2 Treatment of many to many pseudo relations
359 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
360 If it is not loaded in the ResultSource classes - then the code relies on the fact that:
361 if($object->can($name) and
362 !$object->result_source->has_relationship($name) and
363 $object->can( 'set_' . $name )
366 then $name must be a many to many pseudo relation. And that in a
367 similarly ugly was I find out what is the ResultSource of objects from
368 that many to many pseudo relation.
375 =head2 recursive_update
377 The method that does the work here.
381 $self->is_m2m( 'name ' ) - answers the question if 'name' is a many to many
382 (pseudo) relation on $self.
384 =head2 get_m2m_source
386 $self->get_m2m_source( 'name' ) - returns the ResultSource linked to by the many
387 to many (pseudo) relation 'name' from $self.
393 =head1 CONFIGURATION AND ENVIRONMENT
395 DBIx::Class::RecursiveUpdate requires no configuration files or environment variables.
401 =head1 INCOMPATIBILITIES
403 =for author to fill in:
408 =head1 BUGS AND LIMITATIONS
410 =for author to fill in:
412 No bugs have been reported.
414 Please report any bugs or feature requests to
415 C<bug-dbix-class-recursiveput@rt.cpan.org>, or through the web interface at
416 L<http://rt.cpan.org>.
421 Zbigniew Lukasiak C<< <zby@cpan.org> >>
422 Influenced by code by Pedro Melo.
424 =head1 LICENCE AND COPYRIGHT
426 Copyright (c) 2008, Zbigniew Lukasiak C<< <zby@cpan.org> >>. All rights reserved.
428 This module is free software; you can redistribute it and/or
429 modify it under the same terms as Perl itself. See L<perlartistic>.
432 =head1 DISCLAIMER OF WARRANTY
434 BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
435 FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
436 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
437 PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
438 EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
439 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
440 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
441 YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
442 NECESSARY SERVICING, REPAIR, OR CORRECTION.
444 IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
445 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
446 REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
447 LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
448 OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
449 THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
450 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
451 FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
452 SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF