X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-DBIx-Class-ResultSet-RecursiveUpdate;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet%2FRecursiveUpdate.pm;h=2fcba9eae1138893e4886de224c19f5f1997498d;hp=2dc40cba4f7ba698cddb0b5befa90d60a1420249;hb=bd78df322eb57b4a6721b25c1b5b337ebed1913c;hpb=7947dd6ee9711102d5fb3fc579316d830d610da1 diff --git a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm index 2dc40cb..2fcba9e 100644 --- a/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm +++ b/lib/DBIx/Class/ResultSet/RecursiveUpdate.pm @@ -1,177 +1,462 @@ +use strict; +use warnings; + package DBIx::Class::ResultSet::RecursiveUpdate; -use version; $VERSION = qv('0.001'); +our $VERSION = '0.013'; -use warnings; -use strict; +use base qw(DBIx::Class::ResultSet); + +sub recursive_update { + my ( $self, $updates, $fixed_fields ) = @_; + return + DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update( + resultset => $self, + updates => $updates, + fixed_fields => $fixed_fields + ); +} + +package DBIx::Class::ResultSet::RecursiveUpdate::Functions; use Carp; +use Scalar::Util qw( blessed ); + +sub recursive_update { + my %params = @_; + my ( $self, $updates, $fixed_fields, $object, $resolved, + $if_not_submitted ) + = @params{ + qw/resultset updates fixed_fields object resolved if_not_submitted/}; + $resolved ||= {}; + + # warn 'entering: ' . $self->result_source->from(); + carp 'fixed fields needs to be an array ref' + if $fixed_fields && ref($fixed_fields) ne 'ARRAY'; + my %fixed_fields; + %fixed_fields = map { $_ => 1 } @$fixed_fields if $fixed_fields; + if ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) { + return $updates; + } + if ( $updates->{id} ) { + $object = $self->find( $updates->{id}, { key => 'primary' } ); + } + my @missing = + grep { !exists $updates->{$_} && !exists $fixed_fields{$_} } + $self->result_source->primary_columns; + if ( !$object && !scalar @missing ) { -use base qw(DBIx::Class::ResultSet); + # warn 'finding by: ' . Dumper( $updates ); use Data::Dumper; + $object = $self->find( $updates, { key => 'primary' } ); + } + $updates = { %$updates, %$resolved }; + @missing = + grep { !exists $resolved->{$_} } @missing; + if ( !$object && !scalar @missing ) { -sub recursive_update { - my( $self, $updates ) = @_; - my $object; - $object = $self->find( $updates, { key => 'primary' } ) || $self->new( {} ); - - for my $name ( keys %$updates ){ - if($object->can($name)){ - my $value = $updates->{$name}; - - # updating relations that that should be done before the row is inserted into the database - # like belongs_to - if( $object->result_source->has_relationship($name) - and - ref $value - ){ - my $info = $object->result_source->relationship_info( $name ); - if( $info and not $info->{attrs}{accessor} eq 'multi' - and - _master_relation_cond( $object, $info->{cond}, $self->_get_pk_for_related( $name ) ) - ){ - my $related_result = $object->related_resultset( $name ); - my $sub_object = $related_result->recursive_update( $value ); - $object->set_from_related( $name, $sub_object ); - } + # warn 'finding by +resolved: ' . Dumper( $updates ); use Data::Dumper; + $object = $self->find( $updates, { key => 'primary' } ); + } + $object ||= $self->new( {} ); + + # warn Dumper( $updates ); use Data::Dumper; + # direct column accessors + my %columns; + + # relations that that should be done before the row is inserted into the + # database like belongs_to + my %pre_updates; + + # relations that that should be done after the row is inserted into the + # database like has_many, might_have and has_one + my %post_updates; + my %other_methods; + my %columns_by_accessor = _get_columns_by_accessor($self); + + # warn 'resolved: ' . Dumper( $resolved ); + # warn 'updates: ' . Dumper( $updates ); use Data::Dumper; + # warn 'columns: ' . Dumper( \%columns_by_accessor ); + for my $name ( keys %$updates ) { + my $source = $self->result_source; + + # columns + if ( exists $columns_by_accessor{$name} + && !( $source->has_relationship($name) + && ref( $updates->{$name} ) ) ) + { + + #warn "$name is a column\n"; + $columns{$name} = $updates->{$name}; + next; + } + + # relationships + if ( $source->has_relationship($name) ) { + my $info = $source->relationship_info($name); + if (_master_relation_cond( + $source, $info->{cond}, + _get_pk_for_related( $self, $name ) + ) + ) + { + + #warn "$name is a pre-update rel\n"; + $pre_updates{$name} = $updates->{$name}; + next; } - # columns and other accessors - elsif( $object->result_source->has_column($name) - or - !$object->can( 'set_' . $name ) - ) { - $object->$name($value); + else { + + #warn "$name is a post-update rel\n"; + $post_updates{$name} = $updates->{$name}; + next; } } - #warn Dumper($object->{_column_data}); use Data::Dumper; + + # many-to-many helper accessors + if ( is_m2m( $self, $name ) ) { + + #warn "$name is a many-to-many helper accessor\n"; + $other_methods{$name} = $updates->{$name}; + next; + } + + # accessors + if ( $object->can($name) && not $source->has_relationship($name) ) { + + #warn "$name is an accessor"; + $other_methods{$name} = $updates->{$name}; + next; + } + + # unknown + # TODO: don't throw a warning instead of an exception to give users + # time to adapt to the new API + $self->throw_exception( + "No such column, relationship, many-to-many helper accessor or generic accessor '$name'" + ); + } + + # warn 'other: ' . Dumper( \%other_methods ); use Data::Dumper; + + # first update columns and other accessors + # so that later related records can be found + for my $name ( keys %columns ) { + #warn "update col $name\n"; + $object->$name( $columns{$name} ); } - $self->_delete_empty_auto_increment($object); - # don't allow insert to recurse to related objects - we do the recursion ourselves - $object->{_rel_in_storage} = 1; - $object->update_or_insert; - - # updating relations that can be done only after the row is inserted into the database - # like has_many and many_to_many - for my $name ( keys %$updates ){ + for my $name ( keys %other_methods ) { + #warn "update other $name\n"; + $object->$name( $updates->{$name} ); + } + for my $name ( keys %pre_updates ) { + #warn "pre_update $name\n"; + _update_relation( $self, $name, $pre_updates{$name}, $object, + $if_not_submitted ); + } + + # $self->_delete_empty_auto_increment($object); + # don't allow insert to recurse to related objects + # do the recursion ourselves + # $object->{_rel_in_storage} = 1; + #warn "CHANGED: " . $object->is_changed . " IN STOR: " . $object->in_storage . "\n"; + $object->update_or_insert if $object->is_changed; + + # updating many_to_many + for my $name ( keys %$updates ) { + next if exists $columns{$name}; my $value = $updates->{$name}; - # many to many case - if( $self->is_m2m( $name ) ) { - my ( $pk ) = $self->_get_pk_for_related( $name ); - my @rows; - my $result_source = $object->$name->result_source; - for my $elem ( @{$updates->{$name}} ){ - if( ref $elem ){ - push @rows, $result_source->resultset->find( $elem ); - } - else{ - push @rows, $result_source->resultset->find( { $pk => $elem } ); - } + + if ( is_m2m( $self, $name ) ) { + #warn "update m2m $name\n"; + my ($pk) = _get_pk_for_related( $self, $name ); + my @rows; + my $result_source = $object->$name->result_source; + my @updates; + if ( !defined $value ) { + next; + } + elsif ( ref $value ) { + @updates = @{$value}; + } + else { + @updates = ($value); + } + for my $elem (@updates) { + if ( ref $elem ) { + push @rows, + recursive_update( + resultset => $result_source->resultset, + updates => $elem + ); } - my $set_meth = 'set_' . $name; - $object->$set_meth( \@rows ); - } - elsif( $object->result_source->has_relationship($name) ){ - my $info = $object->result_source->relationship_info( $name ); - # has many case - if( ref $updates->{$name} eq 'ARRAY' ){ - for my $sub_updates ( @{$updates->{$name}} ) { - my $sub_object = $object->search_related( $name )->recursive_update( $sub_updates ); + else { + push @rows, + $result_source->resultset->find( { $pk => $elem } ); } } - # might_have and has_one case - elsif ( ! _master_relation_cond( $object, $info->{cond}, $self->_get_pk_for_related( $name ) ) ){ - my $sub_object = $object->search_related( $name )->recursive_update( $value ); - #$object->set_from_related( $name, $sub_object ); - } + my $set_meth = 'set_' . $name; + $object->$set_meth( \@rows ); } } + for my $name ( keys %post_updates ) { + #warn "post_update $name\n"; + _update_relation( $self, $name, $post_updates{$name}, $object, + $if_not_submitted ); + } return $object; } +# returns DBIx::Class::ResultSource::column_info as a hash indexed by column accessor || name +sub _get_columns_by_accessor { + my $self = shift; + my $source = $self->result_source; + my %columns; + for my $name ( $source->columns ) { + my $info = $source->column_info($name); + $info->{name} = $name; + $columns{ $info->{accessor} || $name } = $info; + } + return %columns; +} + +# Arguments: $rs, $name, $updates, $row, $if_not_submitted + +sub _update_relation { + my ( $self, $name, $updates, $object, $if_not_submitted ) = @_; + + # this should never happen because we're checking the paramters passed to + # recursive_update, but just to be sure... + $object->throw_exception("No such relationship '$name'") + unless $object->has_relationship($name); + + #warn "_update_relation $name: OBJ: " . ref($object) . " IN STOR: " . $object->in_storage . "\n"; + + my $info = $object->result_source->relationship_info($name); + + # get a related resultset without a condition + my $related_resultset = + $self->related_resultset($name)->result_source->resultset; + my $resolved; + if ( $self->result_source->can('_resolve_condition') ) { + $resolved = + $self->result_source->_resolve_condition( $info->{cond}, $name, + $object ); + } + + # warn "$name resolved: " . Dumper( $resolved ); use Data::Dumper; + $resolved = {} + if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION + && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION + == $resolved; + + my $rel_col_cnt = scalar keys %{ $info->{cond} }; + use Data::Dumper; + warn "RELINFO for $name: " . Dumper($info); + warn "REL_COL_CNT: $rel_col_cnt"; + + #warn "REV RELINFO for $name: " . Dumper($revrelinfo); + + # the only valid datatype for a has_many rels is an arrayref + if ( $info->{attrs}{accessor} eq 'multi' ) { + $self->throw_exception( + "data for has_many relationship '$name' must be an arrayref") + unless ref $updates eq 'ARRAY'; + + my @updated_ids; + for my $sub_updates ( @{$updates} ) { + my $sub_object = recursive_update( + resultset => $related_resultset, + updates => $sub_updates, + resolved => $resolved + ); + push @updated_ids, $sub_object->id; + } + my @related_pks = $related_resultset->result_source->primary_columns; + if ( defined $if_not_submitted && $if_not_submitted eq 'delete' ) { + + # only handles related result classes with single primary keys + if ( 1 == scalar @related_pks ) { + $object->$name->search( + { $related_pks[0] => { -not_in => \@updated_ids } } ) + ->delete; + } + } + elsif ( defined $if_not_submitted + && $if_not_submitted eq 'set_to_null' ) + { + + # only handles related result classes with single primary keys + if ( 1 == scalar @related_pks ) { + my @fk = keys %$resolved; + $object->$name->search( + { $related_pks[0] => { -not_in => \@updated_ids } } ) + ->update( { $fk[0] => undef } ); + } + } + } + elsif ($info->{attrs}{accessor} eq 'single' + || $info->{attrs}{accessor} eq 'filter' ) + { + #warn "\tupdating rel '$name': $if_not_submitted\n"; + my $sub_object; + if ( ref $updates ) { + + # for might_have relationship + if ( $info->{attrs}{accessor} eq 'single' + && defined $object->$name ) + { + $sub_object = recursive_update( + resultset => $related_resultset, + updates => $updates, + object => $object->$name + ); + } + else { + $sub_object = recursive_update( + resultset => $related_resultset, + updates => $updates, + resolved => $resolved + ); + } + } + else { + $sub_object = $related_resultset->find($updates) + unless ( + !$updates + && ( exists $info->{attrs}{join_type} + && $info->{attrs}{join_type} eq 'LEFT' ) + ); + } + $object->set_from_related( $name, $sub_object ) + unless ( + !$sub_object + && !$updates + && ( exists $info->{attrs}{join_type} + && $info->{attrs}{join_type} eq 'LEFT' ) + ); + } + else { + $self->throw_exception( + "recursive_update doesn't now how to handle relationship '$name' with accessor " + . $info->{attrs}{accessor} ); + } +} + sub is_m2m { - my( $self, $relation ) = @_; - my $object = $self->new({}); - if ( $object->can($relation) and - !$object->result_source->has_relationship($relation) and - $object->can( 'set_' . $relation) - ){ + my ( $self, $relation ) = @_; + my $rclass = $self->result_class; + + # DBIx::Class::IntrospectableM2M + if ( $rclass->can('_m2m_metadata') ) { + return $rclass->_m2m_metadata->{$relation}; + } + my $object = $self->new( {} ); + if ( $object->can($relation) + and !$self->result_source->has_relationship($relation) + and $object->can( 'set_' . $relation ) ) + { return 1; } return; } sub get_m2m_source { - my( $self, $relation ) = @_; - my $object = $self->new({}); + my ( $self, $relation ) = @_; + my $rclass = $self->result_class; + + # DBIx::Class::IntrospectableM2M + if ( $rclass->can('_m2m_metadata') ) { + return $self->result_source->related_source( + $rclass->_m2m_metadata->{$relation}{relation} ) + ->related_source( + $rclass->_m2m_metadata->{$relation}{foreign_relation} ); + } + my $object = $self->new( {} ); my $r = $object->$relation; return $r->result_source; } - sub _delete_empty_auto_increment { my ( $self, $object ) = @_; - for my $col ( keys %{$object->{_column_data}}){ - if( $object->result_source->column_info( $col )->{is_auto_increment} - and - ( ! defined $object->{_column_data}{$col} or $object->{_column_data}{$col} eq '' ) - ){ - delete $object->{_column_data}{$col} + for my $col ( keys %{ $object->{_column_data} } ) { + if ($object->result_source->column_info($col)->{is_auto_increment} + and ( !defined $object->{_column_data}{$col} + or $object->{_column_data}{$col} eq '' ) + ) + { + delete $object->{_column_data}{$col}; } } } sub _get_pk_for_related { my ( $self, $relation ) = @_; - my $result_source; - if( $self->result_source->has_relationship( $relation ) ){ - $result_source = $self->result_source->related_source( $relation ); + if ( $self->result_source->has_relationship($relation) ) { + $result_source = $self->result_source->related_source($relation); } + # many to many case - if ( $self->is_m2m( $relation ) ) { - $result_source = $self->get_m2m_source( $relation ); + if ( is_m2m( $self, $relation ) ) { + $result_source = get_m2m_source( $self, $relation ); } return $result_source->primary_columns; } +# This function determines wheter a relationship should be done before or +# after the row is inserted into the database +# relationships before: belongs_to +# relationships after: has_many, might_have and has_one +# true means before, false after sub _master_relation_cond { - my ( $object, $cond, @foreign_ids ) = @_; + my ( $source, $cond, @foreign_ids ) = @_; my $foreign_ids_re = join '|', @foreign_ids; - if ( ref $cond eq 'HASH' ){ + if ( ref $cond eq 'HASH' ) { for my $f_key ( keys %{$cond} ) { + # might_have is not master my $col = $cond->{$f_key}; $col =~ s/self\.//; - if( $object->column_info( $col )->{is_auto_increment} ){ + if ( $source->column_info($col)->{is_auto_increment} ) { return 0; } - if( $f_key =~ /^foreign\.$foreign_ids_re/ ){ + if ( $f_key =~ /^foreign\.$foreign_ids_re/ ) { return 1; } } - }elsif ( ref $cond eq 'ARRAY' ){ - for my $new_cond ( @$cond ) { - return 1 if _master_relation_cond( $object, $new_cond, @foreign_ids ); + } + elsif ( ref $cond eq 'ARRAY' ) { + for my $new_cond (@$cond) { + return _master_relation_cond( $source, $new_cond, @foreign_ids ); } } return; } -# Module implementation here - - -1; # Magic true value required at end of module +1; # Magic true value required at end of module __END__ =head1 NAME -DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive +DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive +=head1 SYNOPSIS -=head1 VERSION - -This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.001 +The functional interface: + + my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({ + resultset => $schema->resultset( 'Dvd' ), + updates => { + id => 1, + owned_dvds => [ + { + title => 'One Flew Over the Cuckoo's Nest' + } + ] + } + }); -=head1 SYNOPSIS +As ResultSet subclass: __PACKAGE__->load_namespaces( default_resultset_class => '+DBIx::Class::ResultSet::RecursiveUpdate' ); @@ -183,7 +468,6 @@ Then: id => 1, owned_dvds => [ { - id => undef, title => 'One Flew Over the Cuckoo's Nest' } ] @@ -193,6 +477,9 @@ Then: =head1 DESCRIPTION +This is still experimental. I've added a functional interface so that it can be used +in Form Processors and not require modification of the model. + You can feed the ->create method with a recursive datastructure and have the related records created. Unfortunately you cannot do a similar thing with update_or_create - this module tries to fill that void. @@ -202,57 +489,171 @@ which works just like update_or_create but can recursively update or create data objects composed of multiple rows. All rows need to be identified by primary keys - so you need to provide them in the update structure (unless they can be deduced from the parent row - for example when you have a belongs_to relationship). -When creating new rows in a table with auto_increment primary keys you need to -put 'undef' for the key value - this is then removed -and a correct INSERT statement is generated. +If not all colums comprising the primary key are specified - then a new row will be created, +with the expectation that the missing columns will be filled by it (as in the case of auto_increment +primary keys). + + +If the resultset itself stores an assignement for the primary key, +like in the case of: + + my $restricted_rs = $user_rs->search( { id => 1 } ); + +then you need to inform recursive_update about additional predicate with a second argument: + + my $user = $restricted_rs->recursive_update( { + owned_dvds => [ + { + title => 'One Flew Over the Cuckoo's Nest' + } + ] + }, + [ 'id' ] + ); + +This will work with a new DBIC release. For a many_to_many (pseudo) relation you can supply a list of primary keys from the other table - and it will link the record at hand to those and only those records identified by them. This is convenient for handling web forms with check boxes (or a SELECT box with multiple choice) that let you -update such (pseudo) relations. +update such (pseudo) relations. For a description how to set up base classes for ResultSets see load_namespaces in DBIx::Class::Schema. =head1 DESIGN CHOICES -=head2 Treatment of many to many pseudo relations +Columns and relationships which are excluded from the updates hashref aren't +touched at all. -Matt Trout expressed following criticism of the support for many to many in -RecursiveUpdate and since this is an extension of his DBIx::Class I feel obliged to -reply to it. It is about two points leading in his opinion to 'fragile and -implicitely broken code'. +=head2 Treatment of belongs_to relations -1. That I rely on the fact that +In case the relationship is included but undefined in the updates hashref, +all columns forming the relationship will be set to null. +If not all of them are nullable, DBIx::Class will throw an error. - if($object->can($name) and - !$object->result_source->has_relationship($name) and - $object->can( 'set_' . $name ) - ) +Updating the relationship: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + owner => $user->id, + }); + +Clearing the relationship (only works if cols are nullable!): + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + owner => undef, + }); -then $name must be a many to many pseudo relation. And that in a -similarly ugly was I find out what is the ResultSource of objects from -that many to many pseudo relation. +=head2 Treatment of might_have relationships -2. That I treat uniformly relations and many to many (which are -different from relations because they require traversal of the bridge -table). +In case the relationship is included but undefined in the updates hashref, +all columns forming the relationship will be set to null. -To answer 1) I've refactored that 'dirty' code into is_m2m and get_m2m_source so -that it can be easily overridden. I agree that this code is not too nice - but -currenlty it is the only way to do what I need - and I'll replace it as soon as -there is a more clean way. I don't think it is extremely brittle - sure it will -break if many to many (pseudo) relations don't get 'set_*' methods anymore - but -I would say it is rather justified for this kind of change in underlying library -to break it. +Updating the relationship: + my $user = $user_rs->recursive_update( { + id => 1, + address => { + street => "101 Main Street", + city => "Podunk", + state => "New York", + } + }); + +Clearing the relationship: + + my $user = $user_rs->recursive_update( { + id => 1, + address => undef, + }); + +=head2 Treatment of has_many relations + +If a relationship key is included in the data structure with a value of undef +or an empty array, all existing related rows will be deleted, or their foreign +key columns will be set to null. + +The exact behaviour depends on the nullability of the foreign key columns and +the value of the "if_not_submitted" parameter. The parameter defaults to +undefined which neither nullifies nor deletes. + +When the array contains elements they are updated if they exist, created when +not and deleted if not included. + +=head3 All foreign table columns are nullable + +In this case recursive_update defaults to nullifying the foreign columns. + +=head3 Not all foreign table columns are nullable + +In this case recursive_update deletes the foreign rows. + +Updating the relationship: + + Passing ids: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [1, 2], + }); + + Passing hashrefs: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [ + { + id => 1, + file => 'file0' + }, + { + id => 2, + file => 'file1', + }, + ], + }); -Ad 2) - first this is not strictly true - RecursiveUpdate does have -different code to cope with m2m and other cases (see the point above for -example) - but it let's the user to treat m2m and 'normal' relations in a -uniform way. I consider this a form of abstraction - it is the work that -RecursiveUpdate does for the programmer. + Passing objects: + + TODO + + You can even mix them: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [ '2', { id => '3' } ], + }); + +Clearing the relationship: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => undef, + }); + + This is the same as passing an empty array: + + my $dvd = $dvd_rs->recursive_update( { + id => 1, + tags => [], + }); + +=head2 Treatment of many-to-many pseudo relations + +The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M. +If it isn't loaded in the ResultSource classes the code relies on the fact that: + + if($object->can($name) and + !$object->result_source->has_relationship($name) and + $object->can( 'set_' . $name ) + ) + +Then $name must be a many to many pseudo relation. +And that in a similarly ugly was I find out what is the ResultSource of +objects from that many to many pseudo relation. =head1 INTERFACE @@ -287,15 +688,11 @@ DBIx::Class::RecursiveUpdate requires no configuration files or environment vari =head1 INCOMPATIBILITIES -=for author to fill in: - None reported. =head1 BUGS AND LIMITATIONS -=for author to fill in: - No bugs have been reported. Please report any bugs or feature requests to