X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FRow.pm;h=7195bba57e4e224eb9084a8fe249e9e40b88e250;hb=2bc3c81ece67606c69cfb18eaeebb05db706d776;hp=b162dd275052611561209f85625210f8d5ee0446;hpb=2ec8e594a56e3fe8eabd116aace724de36e1c38e;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index b162dd2..7195bba 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -6,6 +6,7 @@ use warnings;
 use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
 use Scalar::Util ();
+use Scope::Guard;
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_source_handle/);
 
@@ -64,6 +65,7 @@ sub new {
     my ($related,$inflated);
     ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
     $new->{_rel_in_storage} = 1;
+
     foreach my $key (keys %$attrs) {
       if (ref $attrs->{$key}) {
         ## Can we extract this lot to use with update(_or .. ) ?
@@ -74,8 +76,10 @@ sub new {
           my $rel_obj = delete $attrs->{$key};
           if(!Scalar::Util::blessed($rel_obj)) {
             $rel_obj = $new->find_or_new_related($key, $rel_obj);
-            $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
           }
+
+          $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+
           $new->set_from_related($key, $rel_obj);        
           $related->{$key} = $rel_obj;
           next;
@@ -88,6 +92,8 @@ sub new {
               $rel_obj = $new->new_related($key, $rel_obj);
               $new->{_rel_in_storage} = 0;
             }
+
+            $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
           }
           $related->{$key} = $others;
           next;
@@ -97,8 +103,8 @@ sub new {
           ## 'filter' should disappear and get merged in with 'single' above!
           my $rel_obj = delete $attrs->{$key};
           if(!Scalar::Util::blessed($rel_obj)) {
-            $rel_obj = $new->new_related($key, $rel_obj);
-            $new->{_rel_in_storage} = 0;
+            $rel_obj = $new->find_or_new_related($key, $rel_obj);
+            $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
           }
           $inflated->{$key} = $rel_obj;
           next;
@@ -142,53 +148,104 @@ sub insert {
   $self->throw_exception("No result_source set on this object; can't insert")
     unless $source;
 
-  # Check if we stored uninserted relobjs here in new()
-  $source->storage->txn_begin if(!$self->{_rel_in_storage});
+  my $rollback_guard;
 
+  # Check if we stored uninserted relobjs here in new()
   my %related_stuff = (%{$self->{_relationship_data} || {}}, 
                        %{$self->{_inflated_column} || {}});
-  ## Should all be in relationship_data, but we need to get rid of the
-  ## 'filter' reltype..
-  ## These are the FK rels, need their IDs for the insert.
-  foreach my $relname (keys %related_stuff) {
-    my $rel_obj = $related_stuff{$relname};
-    if(Scalar::Util::blessed($rel_obj) && $rel_obj->isa('DBIx::Class::Row')) {
+
+  if(!$self->{_rel_in_storage}) {
+    $source->storage->txn_begin;
+
+    # The guard will save us if we blow out of this scope via die
+
+    $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
+
+    ## Should all be in relationship_data, but we need to get rid of the
+    ## 'filter' reltype..
+    ## These are the FK rels, need their IDs for the insert.
+
+    my @pri = $self->primary_columns;
+
+    REL: foreach my $relname (keys %related_stuff) {
+
+      my $rel_obj = $related_stuff{$relname};
+
+      next REL unless (Scalar::Util::blessed($rel_obj)
+                       && $rel_obj->isa('DBIx::Class::Row'));
+
+      my $cond = $source->relationship_info($relname)->{cond};
+
+      next REL unless ref($cond) eq 'HASH';
+
+      # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
+
+      my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
+
+      # assume anything that references our PK probably is dependent on us
+      # rather than vice versa, unless the far side is (a) defined or (b)
+      # auto-increment
+
+      foreach my $p (@pri) {
+        if (exists $keyhash->{$p}) {
+          warn $keyhash->{$p};
+          unless (defined($rel_obj->get_column($keyhash->{$p}))
+                  || $rel_obj->column_info($keyhash->{$p})
+                             ->{is_auto_increment}) {
+            next REL;
+          }
+        }
+      }
+
       $rel_obj->insert();
       $self->set_from_related($relname, $rel_obj);
+      delete $related_stuff{$relname};
     }
   }
 
   $source->storage->insert($source, { $self->get_columns });
 
   ## PK::Auto
-  my ($pri, $too_many) = grep { !defined $self->get_column($_) || 
-                                    ref($self->get_column($_)) eq 'SCALAR'} $self->primary_columns;
-  if(defined $pri) {
-    $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
-      if defined $too_many;
+  my @auto_pri = grep {
+                   !defined $self->get_column($_) || 
+                   ref($self->get_column($_)) eq 'SCALAR'
+                 } $self->primary_columns;
+
+  if (@auto_pri) {
+    #$self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
+    #  if defined $too_many;
 
     my $storage = $self->result_source->storage;
     $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
       unless $storage->can('last_insert_id');
-    my $id = $storage->last_insert_id($self->result_source,$pri);
-    $self->throw_exception( "Can't get last insert id" ) unless $id;
-    $self->store_column($pri => $id);
+    my @ids = $storage->last_insert_id($self->result_source,@auto_pri);
+    $self->throw_exception( "Can't get last insert id" )
+      unless (@ids == @auto_pri);
+    $self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
   }
 
-  ## Now do the has_many rels, that need $selfs ID.
-  foreach my $relname (keys %related_stuff) {
-    my $relobj = $related_stuff{$relname};
-    if(ref $relobj eq 'ARRAY') {
-      foreach my $obj (@$relobj) {
-        my $info = $self->relationship_info($relname);
-        ## What about multi-col FKs ?
-        my $key = $1 if($info && (keys %{$info->{cond}})[0] =~ /^foreign\.(\w+)/);
-        $obj->set_from_related($key, $self);
-        $obj->insert() if(!$obj->in_storage);
+  if(!$self->{_rel_in_storage}) {
+    ## Now do the has_many rels, that need $selfs ID.
+    foreach my $relname (keys %related_stuff) {
+      my $rel_obj = $related_stuff{$relname};
+      my @cands;
+      if (Scalar::Util::blessed($rel_obj)
+          && $rel_obj->isa('DBIx::Class::Row')) {
+        @cands = ($rel_obj);
+      } elsif (ref $rel_obj eq 'ARRAY') {
+        @cands = @$rel_obj;
+      }
+      if (@cands) {
+        my $reverse = $source->reverse_relationship_info($relname);
+        foreach my $obj (@cands) {
+          $obj->set_from_related($_, $self) for keys %$reverse;
+          $obj->insert() if(!$obj->in_storage);
+        }
       }
     }
+    $source->storage->txn_commit;
+    $rollback_guard->dismiss;
   }
-  $source->storage->txn_commit if(!$self->{_rel_in_storage});
 
   $self->in_storage(1);
   $self->{_dirty_columns} = {};
@@ -222,7 +279,8 @@ required.
 
 Also takes an options hashref of C<< column_name => value> pairs >> to update
 first. But be aware that this hashref might be edited in place, so dont rely on
-it being the same after a call to C<update>.
+it being the same after a call to C<update>. If you need to preserve the hashref,
+it is sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
 
 =cut
 
@@ -395,6 +453,22 @@ sub get_dirty_columns {
            keys %{$self->{_dirty_columns}};
 }
 
+=head2 get_inflated_columns
+
+  my $inflated_data = $obj->get_inflated_columns;
+
+Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
+
+=cut
+
+sub get_inflated_columns {
+  my $self = shift;
+  return map {
+    my $accessor = $self->column_info($_)->{'accessor'} || $_;
+    ($_ => $self->$accessor);
+  } $self->columns;
+}
+
 =head2 set_column
 
   $obj->set_column($col => $val);
@@ -535,6 +609,7 @@ sub inflate_result {
         $fetched = $pre_source->result_class->inflate_result(
                       $pre_source, @{$pre_val});
       }
+      $new->related_resultset($pre)->set_cache([ $fetched ]);
       my $accessor = $source->relationship_info($pre)->{attrs}{accessor};
       $class->throw_exception("No accessor for prefetched $pre")
        unless defined $accessor;
@@ -649,7 +724,7 @@ See Schema's throw_exception.
 
 sub throw_exception {
   my $self=shift;
-  if (ref $self && ref $self->result_source) {
+  if (ref $self && ref $self->result_source && $self->result_source->schema) {
     $self->result_source->schema->throw_exception(@_);
   } else {
     croak(@_);