X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;fp=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=1a9d792f04f2591aebb0e9fec400002a1a50f414;hb=7305f6f933813eaa1a4a7b65bfc5f158d0d65c4d;hp=9da3bd9bacd10f3027b390670f9fd91231031aa7;hpb=3aa25d8b47104964c689be4ca8c1fc5b17781a7f;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 9da3bd9..1a9d792 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -2001,19 +2001,43 @@ sub insert {
   # they can be fused once again with the final return
   $to_insert = { %$to_insert, %$prefetched_values };
 
-  # FIXME - we seem to assume undef values as non-supplied. This is wrong.
-  # Investigate what does it take to s/defined/exists/
   my %pcols = map { $_ => 1 } $source->primary_columns;
+
   my (%retrieve_cols, $autoinc_supplied, $retrieve_autoinc_col);
+
   for my $col ($source->columns) {
+
+    # first autoinc wins - this is why ->columns() in-order iteration is important
+    #
+    # FIXME - there ought to be a sanity-check for multiple is_auto_increment settings
+    # or something...
+    #
     if ($col_infos->{$col}{is_auto_increment}) {
+
+      # FIXME - we seem to assume undef values as non-supplied.
+      # This is wrong.
+      # Investigate what does it take to s/defined/exists/
+      # ( fails t/cdbi/copy.t amoong other things )
       $autoinc_supplied ||= 1 if defined $to_insert->{$col};
+
       $retrieve_autoinc_col ||= $col unless $autoinc_supplied;
     }
 
     # nothing to retrieve when explicit values are supplied
     next if (
-      defined $to_insert->{$col} and ! is_literal_value($to_insert->{$col})
+      # FIXME - we seem to assume undef values as non-supplied.
+      # This is wrong.
+      # Investigate what does it take to s/defined/exists/
+      # ( fails t/cdbi/copy.t amoong other things )
+      defined $to_insert->{$col}
+        and
+      (
+        # not a ref - cheaper to check before a call to is_literal_value()
+        ! length ref $to_insert->{$col}
+          or
+        # not a literal we *MAY* need to pull out ( see check below )
+        ! is_literal_value( $to_insert->{$col} )
+      )
     );
 
     # the 'scalar keys' is a trick to preserve the ->columns declaration order
@@ -2024,6 +2048,35 @@ sub insert {
     );
   };
 
+  # corner case of a non-supplied PK which is *not* declared as autoinc
+  if (
+    ! $autoinc_supplied
+      and
+    ! defined $retrieve_autoinc_col
+      and
+    # FIXME - first come-first serve, suboptimal...
+    ($retrieve_autoinc_col) = ( grep
+      {
+        $pcols{$_}
+          and
+        ! $col_infos->{$_}{retrieve_on_insert}
+          and
+        ! defined $col_infos->{$_}{is_auto_increment}
+      }
+      sort
+        { $retrieve_cols{$a} <=> $retrieve_cols{$b} }
+        keys %retrieve_cols
+    )
+  ) {
+    carp_unique(
+      "Missing value for primary key column '$retrieve_autoinc_col' on "
+    . "@{[ $source->source_name ]} - perhaps you forgot to set its "
+    . "'is_auto_increment' attribute during add_columns()? Treating "
+    . "'$retrieve_autoinc_col' implicitly as an autoinc, and attempting "
+    . 'value retrieval'
+    );
+  }
+
   local $self->{_autoinc_supplied_for_op} = $autoinc_supplied;
   local $self->{_perform_autoinc_retrieval} = $retrieve_autoinc_col;