]> Dogcows Code - chaz/p5-DBIx-Class-ResultSet-RecursiveUpdate/blobdiff - lib/DBIx/Class/ResultSet/RecursiveUpdate.pm
added docs about treatment of belongs_to, might_have and has_many relationships
[chaz/p5-DBIx-Class-ResultSet-RecursiveUpdate] / lib / DBIx / Class / ResultSet / RecursiveUpdate.pm
index 8992718ae78e52bbe1af5818093d2b182bce6e8d..024511a71b90df00a75474cf39adc4f37379e110 100644 (file)
@@ -2,7 +2,7 @@ use strict;
 use warnings;
 package DBIx::Class::ResultSet::RecursiveUpdate;
 
 use warnings;
 package DBIx::Class::ResultSet::RecursiveUpdate;
 
-use version; our $VERSION = qv('0.005');
+our $VERSION = '0.013';
 
 use base qw(DBIx::Class::ResultSet);
 
 
 use base qw(DBIx::Class::ResultSet);
 
@@ -22,7 +22,8 @@ use Scalar::Util qw( blessed );
 
 sub recursive_update {
     my %params = @_;
 
 sub recursive_update {
     my %params = @_;
-    my ( $self, $updates, $fixed_fields, $object ) = @params{ qw/resultset updates fixed_fields object/ }; 
+    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;
     # 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;
@@ -30,6 +31,24 @@ sub recursive_update {
     if ( blessed($updates) && $updates->isa('DBIx::Class::Row') ) {
         return $updates;
     }
     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 ) {
+#        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 ) {
+#        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;
 
     # direct column accessors
     my %columns;
 
@@ -38,11 +57,13 @@ sub recursive_update {
     my %pre_updates;
 
     # relations that that should be done after the row is inserted into the database
     my %pre_updates;
 
     # relations that that should be done after the row is inserted into the database
-    # like has_many and might_have
+    # like has_many, might_have and has_one
     my %post_updates;
     my %other_methods;
     my %columns_by_accessor = _get_columns_by_accessor( $self );
     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;
         if ( $columns_by_accessor{$name}
     for my $name ( keys %$updates ) {
         my $source = $self->result_source;
         if ( $columns_by_accessor{$name}
@@ -52,10 +73,10 @@ sub recursive_update {
             $columns{$name} = $updates->{$name};
             next;
         }
             $columns{$name} = $updates->{$name};
             next;
         }
-        if( !( $source->has_relationship($name) && ref( $updates->{$name} ) ) ){
+        if( !( $source->has_relationship($name) ) ){
             $other_methods{$name} = $updates->{$name};
             $other_methods{$name} = $updates->{$name};
+            next;
         }
         }
-        next if !$source->has_relationship($name);
         my $info = $source->relationship_info($name);
         if (
             _master_relation_cond(
         my $info = $source->relationship_info($name);
         if (
             _master_relation_cond(
@@ -69,30 +90,24 @@ sub recursive_update {
             $post_updates{$name} = $updates->{$name};
         }
     }
             $post_updates{$name} = $updates->{$name};
         }
     }
-    # warn 'columns: ' . Dumper( \%columns ); use Data::Dumper;
-
-    my @missing =
-      grep { !exists $columns{$_} && !exists $fixed_fields{$_} } $self->result_source->primary_columns;
-    if ( !$object && !scalar @missing ) {
-        $object = $self->find( \%columns, { key => 'primary' } );
-    }
-    $object ||= $self->new( {} );
+    # 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 ) {
 
     # first update columns and other accessors - so that later related records can be found
     for my $name ( keys %columns ) {
-        $object->$name( $updates->{$name} );
+        $object->$name( $columns{$name} );
     }
     for my $name ( keys %other_methods) {
         $object->$name( $updates->{$name} ) if $object->can( $name );
     }
     for my $name ( keys %pre_updates ) {
         my $info = $object->result_source->relationship_info($name);
     }
     for my $name ( keys %other_methods) {
         $object->$name( $updates->{$name} ) if $object->can( $name );
     }
     for my $name ( keys %pre_updates ) {
         my $info = $object->result_source->relationship_info($name);
-        _update_relation( $self, $name, $updates, $object, $info );
+        _update_relation( $self, $name, $updates, $object, $info, $if_not_submitted );
     }
 #    $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;
     }
 #    $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;
+
+    $object->update_or_insert if $object->is_changed;
 
     # updating many_to_many
     for my $name ( keys %$updates ) {
 
     # updating many_to_many
     for my $name ( keys %$updates ) {
@@ -103,9 +118,19 @@ sub recursive_update {
             my ($pk) = _get_pk_for_related( $self, $name);
             my @rows;
             my $result_source = $object->$name->result_source;
             my ($pk) = _get_pk_for_related( $self, $name);
             my @rows;
             my $result_source = $object->$name->result_source;
-            for my $elem ( @{ $updates->{$name} } ) {
+            my @updates;
+            if( ! defined $value ){
+                next;
+            }
+            elsif( ref $value ){
+                @updates = @{ $value };
+            }
+            else{
+                @updates = ( $value );
+            }
+            for my $elem ( @updates ) {
                 if ( ref $elem ) {
                 if ( ref $elem ) {
-                    push @rows, $result_source->resultset->find($elem);
+                    push @rows, recursive_update( resultset => $result_source->resultset, updates => $elem );
                 }
                 else {
                     push @rows,
                 }
                 else {
                     push @rows,
@@ -118,11 +143,12 @@ sub recursive_update {
     }
     for my $name ( keys %post_updates ) {
         my $info = $object->result_source->relationship_info($name);
     }
     for my $name ( keys %post_updates ) {
         my $info = $object->result_source->relationship_info($name);
-        _update_relation( $self, $name, $updates, $object, $info );
+        _update_relation( $self, $name, $updates, $object, $info, $if_not_submitted );
     }
     return $object;
 }
 
     }
     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;
 sub _get_columns_by_accessor {
     my $self   = shift;
     my $source = $self->result_source;
@@ -136,38 +162,65 @@ sub _get_columns_by_accessor {
 }
 
 sub _update_relation {
 }
 
 sub _update_relation {
-    my ( $self, $name, $updates, $object, $info ) = @_;
+    my ( $self, $name, $updates, $object, $info, $if_not_submitted ) = @_;
     my $related_result =
       $self->related_resultset($name)->result_source->resultset;
     my $related_result =
       $self->related_resultset($name)->result_source->resultset;
-    my $resolved =
-      $self->result_source->resolve_condition( $info->{cond}, $name, $object );
+    my $resolved;
+    if( $self->result_source->can( '_resolve_condition' ) ){
+        $resolved = $self->result_source->_resolve_condition( $info->{cond}, $name, $object );
+    }
+    else{
+        $resolved = $self->result_source->resolve_condition( $info->{cond}, $name, $object );
+    }
 
  #                    warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
 
  #                    warn 'resolved: ' . Dumper( $resolved ); use Data::Dumper;
-    $resolved = undef
+    $resolved = {}
       if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $resolved;
     if ( ref $updates->{$name} eq 'ARRAY' ) {
       if defined $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION && $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION == $resolved;
     if ( ref $updates->{$name} eq 'ARRAY' ) {
+        my @updated_ids;
         for my $sub_updates ( @{ $updates->{$name} } ) {
         for my $sub_updates ( @{ $updates->{$name} } ) {
-            $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
             my $sub_object =
             my $sub_object =
-              recursive_update( resultset => $related_result, updates => $sub_updates );
+              recursive_update( resultset => $related_result, updates => $sub_updates, resolved => $resolved );
+            push @updated_ids, $sub_object->id;
+        }
+        my @related_pks = $related_result->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 } );
+            }
         }
     }
     else {
         my $sub_updates = $updates->{$name};
         }
     }
     else {
         my $sub_updates = $updates->{$name};
-        $sub_updates = { %$sub_updates, %$resolved } if $resolved && ref( $sub_updates ) eq 'HASH';
         my $sub_object;
         my $sub_object;
-        if( $info->{attrs}{accessor} eq 'single' && defined $object->$name ){
-            $sub_object = recursive_update( 
-                resultset => $related_result, 
-                updates => $sub_updates, 
-                object =>  $object->$name 
-            );
+        if( ref $sub_updates ){
+            # for might_have relationship
+            if( $info->{attrs}{accessor} eq 'single' && defined $object->$name ){
+                $sub_object = recursive_update( 
+                    resultset => $related_result, 
+                    updates => $sub_updates, 
+                    object =>  $object->$name 
+                );
+            }
+            else{
+                $sub_object =
+                recursive_update( resultset => $related_result, updates => $sub_updates, resolved => $resolved );
+            }
+        }
+        elsif( ! ref $sub_updates ){
+            $sub_object = $related_result->find( $sub_updates ) 
+                unless (!$sub_updates && (exists $info->{attrs}{join_type} && $info->{attrs}{join_type} eq 'LEFT'));
         }
         }
-        else{ 
-           $sub_object =
-             recursive_update( resultset => $related_result, updates => $sub_updates );
-         }
-        $object->set_from_related( $name, $sub_object );
+        $object->set_from_related( $name, $sub_object )
+          unless (!$sub_object && !$sub_updates && (exists $info->{attrs}{join_type} && $info->{attrs}{join_type} eq 'LEFT'));
     }
 }
 
     }
 }
 
@@ -233,6 +286,10 @@ sub _get_pk_for_related {
     return $result_source->primary_columns;
 }
 
     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
 sub _master_relation_cond {
     my ( $source, $cond, @foreign_ids ) = @_;
     my $foreign_ids_re = join '|', @foreign_ids;
 sub _master_relation_cond {
     my ( $source, $cond, @foreign_ids ) = @_;
     my $foreign_ids_re = join '|', @foreign_ids;
@@ -266,25 +323,21 @@ __END__
 
 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
 
 
 DBIx::Class::ResultSet::RecursiveUpdate - like update_or_create - but recursive
 
-
-=head1 VERSION
-
-This document describes DBIx::Class::ResultSet::RecursiveUpdate version 0.004
-
-
 =head1 SYNOPSIS
 
 The functional interface:
 
     my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({ 
 =head1 SYNOPSIS
 
 The functional interface:
 
     my $new_item = DBIx::Class::ResultSet::RecursiveUpdate::Functions::recursive_update({ 
-        id => 1, 
-        owned_dvds => [ 
-        { 
-          title => 'One Flew Over the Cuckoo's Nest' 
-        } 
-        ] 
-      }
-    );
+        resultset => $schema->resultset( 'Dvd' ),
+        updates => {
+            id => 1, 
+            owned_dvds => [ 
+                { 
+                  title => 'One Flew Over the Cuckoo's Nest' 
+                } 
+            ] 
+        }
+    });
 
 
 As ResultSet subclass:
 
 
 As ResultSet subclass:
@@ -307,6 +360,7 @@ Then:
 
   
 =head1 DESCRIPTION
 
   
 =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.
 
 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.
 
@@ -354,7 +408,110 @@ in DBIx::Class::Schema.
 
 =head1 DESIGN CHOICES
 
 
 =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.
+
+=head2 Treatment of belongs_to relations
+
+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.
+
+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,
+    });
+
+=head2 Treatment of might_have relationships
+
+In case the relationship is included but undefined in the updates hashref,
+all columns forming the relationship will be set to null.
+
+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
+
+In case the relationship is included but undefined or an empty array, the
+related rows will be deleted or their foreign key column set to null depending
+on if_not_submitted parameter (set_to_null or delete).
+It defaults to undefined which skips both.
+
+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',
+            },
+        ],
+    });
+
+    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 is not loaded in the ResultSource classes - then the code relies on the fact that:
 
 The function gets the information about m2m relations from DBIx::Class::IntrospectableM2M.
 If it is not loaded in the ResultSource classes - then the code relies on the fact that:
@@ -400,15 +557,11 @@ DBIx::Class::RecursiveUpdate requires no configuration files or environment vari
 
 =head1 INCOMPATIBILITIES
 
 
 =head1 INCOMPATIBILITIES
 
-=for author to fill in:
-
 None reported.
 
 
 =head1 BUGS AND LIMITATIONS
 
 None reported.
 
 
 =head1 BUGS AND LIMITATIONS
 
-=for author to fill in:
-
 No bugs have been reported.
 
 Please report any bugs or feature requests to
 No bugs have been reported.
 
 Please report any bugs or feature requests to
This page took 0.026854 seconds and 4 git commands to generate.