diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 9171b9970..b4cdeb067 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -2061,7 +2061,7 @@ sub insert { my %pcols = map { $_ => 1 } $source->primary_columns; - my (%retrieve_cols, $autoinc_supplied, $retrieve_autoinc_col); + my (%retrieve_cols, $autoinc_supplied, $retrieve_autoinc_col, $pk_supplied); for my $col ($source->columns) { @@ -2081,6 +2081,21 @@ sub insert { $retrieve_autoinc_col ||= $col unless $autoinc_supplied; } + # Track if any primary key column has a supplied value (including scalar references) + if ($pcols{$col}) { + $pk_supplied ||= 1 if ( + defined $to_insert->{$col} + and + ( + # not a ref - cheaper to check before a call to is_literal_value() + ! length ref $to_insert->{$col} + or + # is a literal value (like scalar references for database functions) + is_literal_value( $to_insert->{$col} ) + ) + ); + } + # nothing to retrieve when explicit values are supplied next if ( # FIXME - we seem to assume undef values as non-supplied. @@ -2112,6 +2127,8 @@ sub insert { and ! defined $retrieve_autoinc_col and + ! $pk_supplied + and # FIXME - first come-first serve, suboptimal... ($retrieve_autoinc_col) = ( grep { diff --git a/t/752sqlite_scalar_ref_warning.t b/t/752sqlite_scalar_ref_warning.t new file mode 100644 index 000000000..859e759e2 --- /dev/null +++ b/t/752sqlite_scalar_ref_warning.t @@ -0,0 +1,75 @@ +use strict; +use warnings; + +use Test::More; +use Test::Warn; + +use lib qw(t/lib); +use DBICTest; + +# Regression test for RT#169546 +# DBIx-Class incorrectly warns about missing primary key values when using +# scalar references for database functions (like \'UUID()', \'RANDOM()', etc.) + +my $schema = DBICTest->init_schema(); + +# Create a test table with a non-auto-increment primary key +$schema->storage->dbh->do(q{ + CREATE TABLE test_scalar_ref ( + id INTEGER NOT NULL PRIMARY KEY, + name VARCHAR(100) + ) +}); + +# Register the test table as a result source +$schema->register_class( + TestScalarRef => 'DBICTest::Schema::TestScalarRef' +); + +{ + package DBICTest::Schema::TestScalarRef; + use base 'DBIx::Class::Core'; + + __PACKAGE__->table('test_scalar_ref'); + __PACKAGE__->add_columns( + id => { + data_type => 'integer', + is_nullable => 0, + }, + name => { + data_type => 'varchar', + size => 100, + is_nullable => 1, + }, + ); + __PACKAGE__->set_primary_key('id'); +} + +# Test 1: Scalar reference for database function should NOT warn (RT#169546) +# This test will FAIL until the bug is fixed +warning_is { + my $row = $schema->resultset('TestScalarRef')->create({ + id => \'ABS(RANDOM())', # Scalar ref should NOT trigger missing PK warning + name => 'Test Record', + }); + isa_ok($row, 'DBICTest::Schema::TestScalarRef', 'Row created with scalar ref'); +} undef, + 'RT#169546: Scalar reference for database function should not warn about missing PK'; + +# Test 2: Truly missing primary key SHOULD warn +warning_like { + my $row = $schema->resultset('TestScalarRef')->create({ + name => 'Test Record 2', # Missing id should warn + }); +} qr/Missing value for primary key/, + 'Missing primary key correctly generates warning'; + +# Test 3: Explicit value should not warn +warning_is { + my $row = $schema->resultset('TestScalarRef')->create({ + id => 12345, + name => 'Test Record 3', + }); +} undef, 'Explicit primary key value does not warn'; + +done_testing();