X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=t%2F72pg.t;h=9d379302ea7f339edeaf6336d26f0df6ad46328b;hp=0fc3f3d1b0448c0a97d46d67849ad0f39dca4d7b;hb=4c90556806f286093d0806e858abdba329e6dfd3;hpb=46bb5b38b2c2090d73675e4fae2f8ffcb6eee1e6 diff --git a/t/72pg.t b/t/72pg.t index 0fc3f3d..9d37930 100644 --- a/t/72pg.t +++ b/t/72pg.t @@ -1,80 +1,534 @@ +BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } +use DBIx::Class::Optional::Dependencies -skip_all_without => 'test_rdbms_pg'; + use strict; -use warnings; +use warnings; use Test::More; use Test::Exception; -use lib qw(t/lib); +use Test::Warn; +use Config; use DBICTest; +use SQL::Abstract 'is_literal_value'; +use DBIx::Class::_Util qw( is_exception set_subname ); -{ - package DBICTest::Schema::Casecheck; +my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; - use strict; - use warnings; - use base 'DBIx::Class'; - - __PACKAGE__->load_components(qw/Core/); - __PACKAGE__->table('testschema.casecheck'); - __PACKAGE__->add_columns(qw/id name NAME uc_name storecolumn/); - __PACKAGE__->column_info_from_storage(1); - __PACKAGE__->set_primary_key('id'); - - sub store_column { - my ($self, $name, $value) = @_; - $value = '#'.$value if($name eq "storecolumn"); - $self->maybe::next::method($name, $value); +### load any test classes that are defined further down in the file via BEGIN blocks +our @test_classes; #< array that will be pushed into by test classes defined in this file +DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes; + +### pre-connect tests (keep each test separate as to make sure rebless() runs) + { + my $s = DBICTest::Schema->connect($dsn, $user, $pass); + # make sure sqlt_type overrides work (::Storage::DBI::Pg does this) + ok (!$s->storage->_dbh, 'definitely not connected'); + is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection'); + ok (!$s->storage->_dbh, 'still not connected'); } -} +# test LIMIT support { - package DBICTest::Schema::ArrayTest; + my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + drop_test_schema($schema); + create_test_schema($schema); + for (1..6) { + $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); + } + my $it = $schema->resultset('Artist')->search( {}, + { rows => 3, + offset => 2, + order_by => 'artistid' } + ); + is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 6 artists + is( $it->next->name, "Artist 3", "iterator->next ok" ); + $it->next; + $it->next; + $it->next; + is( $it->next, undef, "next past end of resultset ok" ); + + # Limit with select-lock + lives_ok { + $schema->txn_do (sub { + isa_ok ( + $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}), + 'DBICTest::Schema::Artist', + ); + }); + } 'Limited FOR UPDATE select works'; +} - use strict; - use warnings; - use base 'DBIx::Class'; +# check if we indeed do support stuff +my $test_server_supports_insert_returning = do { - __PACKAGE__->load_components(qw/Core/); - __PACKAGE__->table('testschema.array_test'); - __PACKAGE__->add_columns(qw/id arrayfield/); - __PACKAGE__->column_info_from_storage(1); - __PACKAGE__->set_primary_key('id'); + my $si = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info; + die "Unparseable Pg server version: $si->{dbms_version}\n" + unless $si->{normalized_dbms_version}; -} + $si->{normalized_dbms_version} < 8.002 ? 0 : 1; +}; +is ( + DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning, + $test_server_supports_insert_returning, + 'insert returning capability guessed correctly' +); + +my $schema; +for my $use_insert_returning ($test_server_supports_insert_returning + ? (0,1) + : (0) +) { + + # doing it here instead of the actual class to keep the main thing under dfs + # and thus keep catching false positives (so far none, but one never knows) + mro::set_mro("DBICTest::Schema", "c3"); + + my $old_connection = DBICTest::Schema->can('connection'); + + no warnings qw/once redefine/; + local *DBICTest::Schema::connection = set_subname 'DBICTest::Schema::connection' => sub { + my $s = shift->$old_connection(@_); + $s->storage->_use_insert_returning ($use_insert_returning); + $s; + }; + +### test capability override + { + my $s = DBICTest::Schema->connect($dsn, $user, $pass); + + ok (!$s->storage->_dbh, 'definitely not connected'); + + ok ( + ! ($s->storage->_use_insert_returning xor $use_insert_returning), + 'insert returning capability set correctly', + ); + ok (!$s->storage->_dbh, 'still not connected (capability override works)'); + } -my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; +### connect, create postgres-specific test schema -plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test '. - '(note: This test drops and creates tables called \'artist\', \'casecheck\', \'array_test\' and \'sequence_test\''. - ' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\''. - ' as well as following schemas: \'testschema\',\'anothertestschema\'!)' - unless ($dsn && $user); + $schema = DBICTest::Schema->connect($dsn, $user, $pass); + $schema->storage->ensure_connected; + drop_test_schema($schema); + create_test_schema($schema); -plan tests => 42; +### begin main tests -DBICTest::Schema->load_classes( 'Casecheck', 'ArrayTest' ); -my $schema = DBICTest::Schema->connect($dsn, $user, $pass,); +# run a BIG bunch of tests for last-insert-id / Auto-PK / sequence +# discovery + run_apk_tests($schema); #< older set of auto-pk tests + run_extended_apk_tests($schema); #< new extended set of auto-pk tests -# Check that datetime_parser returns correctly before we explicitly connect. -SKIP: { - eval { require DateTime::Format::Pg }; - skip "DateTime::Format::Pg required", 2 if $@; - my $store = ref $schema->storage; - is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage'); +######## test the pg-specific syntax from https://rt.cpan.org/Ticket/Display.html?id=99503 + lives_ok { + is( + $schema->resultset('Artist')->search({ artistid => { -in => \ '(select 4) union (select 5)' } })->count, + 2, + 'Two expected artists found on subselect union within IN', + ); + }; + +### type_info tests + + my $test_type_info = { + 'artistid' => { + 'data_type' => 'integer', + 'is_nullable' => 0, + 'size' => 4, + }, + 'name' => { + 'data_type' => 'character varying', + 'is_nullable' => 1, + 'size' => 100, + 'default_value' => undef, + }, + 'rank' => { + 'data_type' => 'integer', + 'is_nullable' => 0, + 'size' => 4, + 'default_value' => 13, + + }, + 'charfield' => { + 'data_type' => 'character', + 'is_nullable' => 1, + 'size' => 10, + 'default_value' => undef, + }, + 'arrayfield' => { + 'data_type' => 'integer[]', + 'is_nullable' => 1, + 'size' => undef, + 'default_value' => undef, + }, + }; + + my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist'); + my $artistid_defval = delete $type_info->{artistid}->{default_value}; + + # The curor info is too radically different from what is in the column_info + # call - just punt it (DBD::SQLite tests the codepath plenty enough) + unless (DBIx::Class::_ENV_::STRESSTEST_COLUMN_INFO_UNAWARE_STORAGE) { + like( + $artistid_defval, + qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/, + 'columns_info_for - sequence matches Pg get_autoinc_seq expectations' + ); + + is_deeply($type_info, $test_type_info, + 'columns_info_for - column data types'); + } + +####### Array tests + + BEGIN { + package DBICTest::Schema::ArrayTest; + push @main::test_classes, __PACKAGE__; + + use strict; + use warnings; + use base 'DBICTest::BaseResult'; + + __PACKAGE__->table('dbic_t_schema.array_test'); + __PACKAGE__->add_columns(qw/id arrayfield/); + __PACKAGE__->column_info_from_storage(1); + __PACKAGE__->set_primary_key('id'); + + } + SKIP: { + skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002; + + my $arr_rs = $schema->resultset('ArrayTest'); + + lives_ok { + $arr_rs->create({ + arrayfield => [1, 2], + }); + } 'inserting arrayref as pg array data'; + + lives_ok { + $arr_rs->update({ + arrayfield => [3, 4], + }); + } 'updating arrayref as pg array data'; + + $arr_rs->create({ + arrayfield => [5, 6], + }); + + lives_ok { + $schema->populate('ArrayTest', [ + [ qw/arrayfield/ ], + [ [0,0] ], + ]); + } 'inserting arrayref using void ctx populate'; + + # Search using arrays + lives_ok { + is_deeply ( + $arr_rs->search({ arrayfield => { -value => [3,4] } })->first->arrayfield, + [3,4], + 'Array value matches' + ); + } 'searching by arrayref'; + + lives_ok { + is_deeply ( + $arr_rs->search({ arrayfield => { '=' => { -value => [3,4] }} })->first->arrayfield, + [3,4], + 'Array value matches explicit equal' + ); + } 'searching by arrayref (explicit equal sign)'; + + lives_ok { + is_deeply ( + $arr_rs->search({ arrayfield => { '>' => { -value => [3,1] }} })->first->arrayfield, + [3,4], + 'Array value matches greater than' + ); + } 'searching by arrayref (greater than)'; + + lives_ok { + is ( + $arr_rs->search({ arrayfield => { '>' => { -value => [3,7] }} })->count, + 1, + 'Greater than search found [5,6]', + ); + } 'searching by arrayref (greater than)'; + + # Find using arrays + lives_ok { + is_deeply ( + $arr_rs->find({ arrayfield => { -value => [3,4] } })->arrayfield, + [3,4], + 'Array value matches implicit equal' + ); + } 'find by arrayref'; + + lives_ok { + is_deeply ( + $arr_rs->find({ arrayfield => { '=' => { -value => [3,4] }} })->arrayfield, + [3,4], + 'Array value matches explicit equal' + ); + } 'find by arrayref (equal)'; + + # test inferred condition for creation + for my $cond ( + { -value => [3,4] }, + \[ '= ?' => [3, 4] ], + ) { + local $TODO = 'No introspection of complex literal conditions :(' + if is_literal_value $cond; + + + my $arr_rs_cond = $arr_rs->search({ arrayfield => $cond }); + + my $row = $arr_rs_cond->create({}); + is_deeply ($row->arrayfield, [3,4], 'Array value taken from $rs condition'); + $row->discard_changes; + is_deeply ($row->arrayfield, [3,4], 'Array value made it to storage'); + } + + my $arr = [ 1..10 ]; + # exercise the creation-logic even more (akin to t/100populate.t) + for my $insert_value ( + $arr, + { -value => $arr }, + \[ '?', $arr ], + ) { + $arr_rs->delete; + + my @objs = ( + $arr_rs->create({ arrayfield => $insert_value }), + $arr_rs->populate([ { arrayfield => $insert_value } ]), + $arr_rs->populate([ ['arrayfield'], [ $insert_value ] ]), + ); + + my $loose_obj = $arr_rs->new({ arrayfield => $insert_value }); + + unless (is_literal_value $insert_value) { + is_deeply( $_->arrayfield, $arr, 'array value preserved during set_columns' ) + for ($loose_obj, @objs) + } + + push @objs, $loose_obj->insert; + + $_->discard_changes for @objs; + is_deeply( $_->arrayfield, $arr, 'array value correct after discard_changes' ) + for (@objs); + + # insert couple more in void ctx + $arr_rs->populate([ { arrayfield => $insert_value } ]); + $arr_rs->populate([ ['arrayfield'], [ $insert_value ] ]); + + # should have a total of 6 now, all pristine + my @retrieved_objs = $arr_rs->search({ + arrayfield => ref $insert_value eq 'ARRAY' + ? { -value => $insert_value } + : { '=' => $insert_value } + })->all; + is scalar @retrieved_objs, 6, 'Correct count of inserted rows'; + is_deeply( $_->arrayfield, $arr, 'array value correct after storage retrieval' ) + for (@retrieved_objs); + } + } + +########## Case check - my $parser = $schema->storage->datetime_parser; - is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected'); + BEGIN { + package DBICTest::Schema::Casecheck; + push @main::test_classes, __PACKAGE__; + + use strict; + use warnings; + use base 'DBIx::Class::Core'; + + __PACKAGE__->table('dbic_t_schema.casecheck'); + __PACKAGE__->add_columns(qw/id name NAME uc_name/); + __PACKAGE__->column_info_from_storage(1); + __PACKAGE__->set_primary_key('id'); + } + + my $name_info = $schema->source('Casecheck')->column_info( 'name' ); + is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" ); + + my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' ); + is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" ); + + my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' ); + is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" ); + + +## Test ResultSet->update +my $artist = $schema->resultset('Artist')->first; +my $cds = $artist->cds_unordered->search({ + year => { '!=' => 2010 } +}, { prefetch => 'liner_notes' }); +lives_ok { $cds->update({ year => '2010' }) } 'Update on prefetched rs'; + +## Test SELECT ... FOR UPDATE + SKIP: { + skip "Your system does not support unsafe signals (d_sigaction) - unable to run deadlock test", 1 + unless eval { $Config{d_sigaction} and require POSIX }; + + my ($timed_out, $artist2); + + for my $t ( + { + # Make sure that an error was raised, and that the update failed + update_lock => 1, + test_sub => sub { + ok($timed_out, "update from second schema times out"); + ok($artist2->is_column_changed('name'), "'name' column is still dirty from second schema"); + }, + }, + { + # Make sure that an error was NOT raised, and that the update succeeded + update_lock => 0, + test_sub => sub { + ok(! $timed_out, "update from second schema DOES NOT timeout"); + ok(! $artist2->is_column_changed('name'), "'name' column is NOT dirty from second schema"); + }, + }, + ) { + # create a new schema + my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); + $schema2->source("Artist")->name("dbic_t_schema.artist"); + + $schema->txn_do( sub { + my $rs = $schema->resultset('Artist')->search( + { + artistid => 1 + }, + $t->{update_lock} ? { for => 'update' } : {} + ); + ok ($rs->count, 'Count works'); + + my $artist = $rs->next; + is($artist->artistid, 1, "select returns artistid = 1"); + + $timed_out = 0; + + eval { + # can not use %SIG assignment directly - we need sigaction below + # localization to a block still works however + local $SIG{ALRM}; + + POSIX::sigaction( POSIX::SIGALRM() => POSIX::SigAction->new( + sub { die "DBICTestTimeout" }, + )); + + $artist2 = $schema2->resultset('Artist')->find(1); + $artist2->name('fooey'); + + # FIXME - this needs to go away in lieu of a non-retrying runner + # ( i.e. after solving RT#47005 ) + local *DBIx::Class::Storage::DBI::_ping = sub { 1 }, DBIx::Class::_ENV_::OLD_MRO && Class::C3->reinitialize() + if DBIx::Class::_Util::modver_gt_or_eq( 'DBD::Pg' => '3.5.0' ); + + alarm(1); + $artist2->update; + }; + + alarm(0); + + if (is_exception($@)) { + $timed_out = $@ =~ /DBICTestTimeout/ + or die $@; + } + }); + + $t->{test_sub}->(); + } + } + + +######## other older Auto-pk tests + + $schema->source("SequenceTest")->name("dbic_t_schema.sequence_test"); + for (1..5) { + my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); + is($st->pkid1, $_, "Auto-PK for sequence without default: First primary key"); + is($st->pkid2, $_ + 9, "Auto-PK for sequence without default: Second primary key"); + is($st->nonpkid, $_ + 19, "Auto-PK for sequence without default: Non-primary key"); + } + my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); + is($st->pkid1, 55, "Auto-PK for sequence without default: First primary key set manually"); + + +######## test non-serial auto-pk + + if ($schema->storage->_use_insert_returning) { + $schema->source('TimestampPrimaryKey')->name('dbic_t_schema.timestamp_primary_key_test'); + my $row = $schema->resultset('TimestampPrimaryKey')->create({}); + ok $row->id; + } + +######## test with_deferred_fk_checks + + $schema->source('CD')->name('dbic_t_schema.cd'); + $schema->source('Track')->name('dbic_t_schema.track'); + lives_ok { + $schema->storage->with_deferred_fk_checks(sub { + $schema->resultset('Track')->create({ + trackid => 999, cd => 999, position => 1, title => 'deferred FK track' + }); + $schema->resultset('CD')->create({ + artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd' + }); + }); + } 'with_deferred_fk_checks code survived'; + + is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track', + 'code in with_deferred_fk_checks worked'; + + throws_ok { + $schema->resultset('Track')->create({ + trackid => 1, cd => 9999, position => 1, title => 'Track1' + }); + } qr/violates foreign key constraint/i, 'with_deferred_fk_checks is off outside of TXN'; + + # rerun the same under with_deferred_fk_checks + # it is expected to fail, hence the eval + # but it also should not warn + warnings_like { + eval { + $schema->storage->with_deferred_fk_checks(sub { + $schema->resultset('Track')->create({ + trackid => 1, cd => 9999, position => 1, title => 'Track1' + }); + } ) + }; + + like $@, qr/violates foreign key constraint/i, + "Still expected exception on deferred failure at commit time"; + + } [], 'No warnings on deferred rollback'; } -my $dbh = $schema->storage->dbh; -$schema->source("Artist")->name("testschema.artist"); -$schema->source("SequenceTest")->name("testschema.sequence_test"); -{ - local $SIG{__WARN__} = sub {}; - _cleanup ($dbh); +done_testing; + +END { + return unless $schema; + drop_test_schema($schema); + eapk_drop_all($schema); + undef $schema; +}; + - my $artist_table_def = <storage->dbh_do(sub { + my (undef,$dbh) = @_; + + local $dbh->{Warn} = 0; + + my $std_artist_table = <source("SequenceTest")->name("testschema.sequence_test"); , arrayfield INTEGER[] ) EOS - $dbh->do("CREATE SCHEMA testschema;"); - $dbh->do("CREATE TABLE testschema.artist $artist_table_def;"); - $dbh->do("CREATE TABLE testschema.sequence_test (pkid1 integer, pkid2 integer, nonpkid integer, name VARCHAR(100), CONSTRAINT pk PRIMARY KEY(pkid1, pkid2));"); - $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0"); - $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0"); - $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0"); - ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3), "storecolumn" VARCHAR(10));'), 'Creation of casecheck table'); - ok ( $dbh->do('CREATE TABLE testschema.array_test (id serial PRIMARY KEY, arrayfield INTEGER[]);'), 'Creation of array_test table'); - $dbh->do("CREATE SCHEMA anothertestschema;"); - $dbh->do("CREATE TABLE anothertestschema.artist $artist_table_def;"); - $dbh->do("CREATE SCHEMA yetanothertestschema;"); - $dbh->do("CREATE TABLE yetanothertestschema.artist $artist_table_def;"); - $dbh->do('set search_path=testschema,public'); + + $dbh->do("CREATE SCHEMA dbic_t_schema"); + $dbh->do("CREATE TABLE dbic_t_schema.artist $std_artist_table"); + + $dbh->do(<do(<do(<do(<do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0"); + $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0"); + $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0"); + $dbh->do(<do(<do("CREATE SCHEMA dbic_t_schema_2"); + $dbh->do("CREATE TABLE dbic_t_schema_2.artist $std_artist_table"); + $dbh->do("CREATE SCHEMA dbic_t_schema_3"); + $dbh->do("CREATE TABLE dbic_t_schema_3.artist $std_artist_table"); + $dbh->do('set search_path=dbic_t_schema,public'); + $dbh->do("CREATE SCHEMA dbic_t_schema_4"); + $dbh->do("CREATE SCHEMA dbic_t_schema_5"); + $dbh->do(<do('set search_path=public,dbic_t_schema,dbic_t_schema_3'); + $dbh->do('create sequence public.artist_artistid_seq'); #< in the public schema + $dbh->do(<do('set search_path=dbic_t_schema,public'); + }); } -# store_column is called once for create() for non sequence columns -ok(my $storecolumn = $schema->resultset('Casecheck')->create({'storecolumn' => 'a'})); -is($storecolumn->storecolumn, '#a'); # was '##a' +sub drop_test_schema { + my ( $schema, $warn_exceptions ) = @_; + $schema->storage->dbh_do(sub { + my (undef,$dbh) = @_; -# This is in Core now, but it's here just to test that it doesn't break -$schema->class('Artist')->load_components('PK::Auto'); + local $dbh->{Warn} = 0; -cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table'); + for my $stat ( + 'DROP SCHEMA dbic_t_schema_5 CASCADE', + 'DROP SEQUENCE public.artist_artistid_seq CASCADE', + 'DROP SCHEMA dbic_t_schema_4 CASCADE', + 'DROP SCHEMA dbic_t_schema CASCADE', + 'DROP SEQUENCE pkid1_seq CASCADE', + 'DROP SEQUENCE pkid2_seq CASCADE', + 'DROP SEQUENCE nonpkid_seq CASCADE', + 'DROP SCHEMA dbic_t_schema_2 CASCADE', + 'DROP SCHEMA dbic_t_schema_3 CASCADE', + ) { + eval { $dbh->do ($stat) }; + diag $@ if $@ && $warn_exceptions; + } + }); +} -{ # test that auto-pk also works with the defined search path by - # un-schema-qualifying the table name - my $artist_name_save = $schema->source("Artist")->name; - $schema->source("Artist")->name("artist"); - my $unq_new; - lives_ok { - $unq_new = $schema->resultset('Artist')->create({ name => 'baz' }); - } 'insert into unqualified, shadowed table succeeds'; +### auto-pk / last_insert_id / sequence discovery +sub run_apk_tests { + my $schema = shift; + + # This is in Core now, but it's here just to test that it doesn't break + $schema->class('Artist')->load_components('PK::Auto'); + cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table'); + + # test that auto-pk also works with the defined search path by + # un-schema-qualifying the table name + apk_t_set($schema,'artist'); + + my $unq_new; + lives_ok { + $unq_new = $schema->resultset('Artist')->create({ name => 'baz' }); + } 'insert into unqualified, shadowed table succeeds'; + + is($unq_new && $unq_new->artistid, 1, "and got correct artistid"); + + my @test_schemas = ( [qw| dbic_t_schema_2 1 |], + [qw| dbic_t_schema_3 1 |], + [qw| dbic_t_schema_4 2 |], + [qw| dbic_t_schema_5 1 |], + ); + foreach my $t ( @test_schemas ) { + my ($sch_name, $start_num) = @$t; + #test with dbic_t_schema_2 + apk_t_set($schema,"$sch_name.artist"); + my $another_new; + lives_ok { + $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'}); + is( $another_new->artistid,$start_num, "got correct artistid for $sch_name") + or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); + } "$sch_name liid 1 did not die" + or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); + lives_ok { + $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'}); + is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name") + or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); + } "$sch_name liid 2 did not die" + or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || ''); + + } + + lives_ok { + apk_t_set($schema,'dbic_t_schema.artist'); + my $new = $schema->resultset('Artist')->create({ name => 'foo' }); + is($new->artistid, 4, "Auto-PK worked"); + $new = $schema->resultset('Artist')->create({ name => 'bar' }); + is($new->artistid, 5, "Auto-PK worked"); + } 'old auto-pk tests did not die either'; +} + +# sets the artist table name and clears sequence name cache +sub apk_t_set { + my ( $s, $n ) = @_; + $s->source("Artist")->name($n); + $s->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache +} + - is($unq_new && $unq_new->artistid, 1, "and got correct artistid"); +######## EXTENDED AUTO-PK TESTS - $schema->source("Artist")->name($artist_name_save); +my @eapk_id_columns; +BEGIN { + package DBICTest::Schema::ExtAPK; + push @main::test_classes, __PACKAGE__; + + use strict; + use warnings; + use base 'DBIx::Class::Core'; + + __PACKAGE__->table('apk'); + + @eapk_id_columns = qw( id1 id2 id3 id4 ); + __PACKAGE__->add_columns( + map { $_ => { data_type => 'integer', is_auto_increment => 1 } } + @eapk_id_columns + ); + + __PACKAGE__->set_primary_key('id2'); #< note the SECOND column is + #the primary key } -my $new = $schema->resultset('Artist')->create({ name => 'foo' }); - -is($new->artistid, 2, "Auto-PK worked"); - -$new = $schema->resultset('Artist')->create({ name => 'bar' }); - -is($new->artistid, 3, "Auto-PK worked"); - - -my $test_type_info = { - 'artistid' => { - 'data_type' => 'integer', - 'is_nullable' => 0, - 'size' => 4, - }, - 'name' => { - 'data_type' => 'character varying', - 'is_nullable' => 1, - 'size' => 100, - 'default_value' => undef, - }, - 'rank' => { - 'data_type' => 'integer', - 'is_nullable' => 0, - 'size' => 4, - 'default_value' => 13, - - }, - 'charfield' => { - 'data_type' => 'character', - 'is_nullable' => 1, - 'size' => 10, - 'default_value' => undef, - }, - 'arrayfield' => { - 'data_type' => 'integer[]', - 'is_nullable' => 1, - 'size' => undef, - 'default_value' => undef, - }, -}; +my @eapk_schemas; +BEGIN{ @eapk_schemas = map "dbic_apk_$_", 0..5 } +my %seqs; #< hash of schema.table.col => currval of its (DBIC) primary key sequence +sub run_extended_apk_tests { + my $schema = shift; -my $type_info = $schema->storage->columns_info_for('testschema.artist'); -my $artistid_defval = delete $type_info->{artistid}->{default_value}; -like($artistid_defval, - qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/, - 'columns_info_for - sequence matches Pg get_autoinc_seq expectations'); -is_deeply($type_info, $test_type_info, - 'columns_info_for - column data types'); + #save the search path and reset it at the end + my $search_path_save = eapk_get_search_path($schema); -SKIP: { - skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002; + eapk_drop_all($schema); + %seqs = (); - lives_ok { - $schema->resultset('ArrayTest')->create({ - arrayfield => [1, 2], - }); - } 'inserting arrayref as pg array data'; + # make the test schemas and sequences + $schema->storage->dbh_do(sub { + my ( undef, $dbh ) = @_; - lives_ok { - $schema->resultset('ArrayTest')->update({ - arrayfield => [3, 4], - }); - } 'updating arrayref as pg array data'; + $dbh->do("CREATE SCHEMA $_") + for @eapk_schemas; + + $dbh->do("CREATE SEQUENCE $eapk_schemas[5].fooseq"); + $dbh->do("SELECT setval('$eapk_schemas[5].fooseq',400)"); + $seqs{"$eapk_schemas[1].apk.id2"} = 400; + + $dbh->do("CREATE SEQUENCE $eapk_schemas[4].fooseq"); + $dbh->do("SELECT setval('$eapk_schemas[4].fooseq',300)"); + $seqs{"$eapk_schemas[3].apk.id2"} = 300; - $schema->resultset('ArrayTest')->create({ - arrayfield => [5, 6], + $dbh->do("CREATE SEQUENCE $eapk_schemas[3].fooseq"); + $dbh->do("SELECT setval('$eapk_schemas[3].fooseq',200)"); + $seqs{"$eapk_schemas[4].apk.id2"} = 200; + + $dbh->do("SET search_path = ".join ',', reverse @eapk_schemas ); }); - my $count; - lives_ok { - $count = $schema->resultset('ArrayTest')->search({ - arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ], #Todo anything less ugly than this? - })->count; - } 'comparing arrayref to pg array data does not blow up'; - is($count, 1, 'comparing arrayref to pg array data gives correct result'); + # clear our search_path cache + $schema->storage->{_pg_search_path} = undef; + + eapk_create( $schema, + with_search_path => [0,1], + ); + eapk_create( $schema, + with_search_path => [1,0,'public'], + nextval => "$eapk_schemas[5].fooseq", + ); + eapk_create( $schema, + with_search_path => ['public',0,1], + qualify_table => 2, + ); + eapk_create( $schema, + with_search_path => [3,1,0,'public'], + nextval => "$eapk_schemas[4].fooseq", + ); + eapk_create( $schema, + with_search_path => [3,1,0,'public'], + nextval => "$eapk_schemas[3].fooseq", + qualify_table => 4, + ); + + eapk_poke( $schema ); + eapk_poke( $schema, 0 ); + eapk_poke( $schema, 2 ); + eapk_poke( $schema, 4 ); + eapk_poke( $schema, 1 ); + eapk_poke( $schema, 0 ); + eapk_poke( $schema, 1 ); + eapk_poke( $schema ); + eapk_poke( $schema, 4 ); + eapk_poke( $schema, 3 ); + eapk_poke( $schema, 1 ); + eapk_poke( $schema, 2 ); + eapk_poke( $schema, 0 ); + + # set our search path back + eapk_set_search_path( $schema, @$search_path_save ); } +# do a DBIC create on the apk table in the given schema number (which is an +# index of @eapk_schemas) + +sub eapk_poke { + my ($s, $schema_num) = @_; + + my $schema_name = defined $schema_num + ? $eapk_schemas[$schema_num] + : ''; -my $name_info = $schema->source('Casecheck')->column_info( 'name' ); -is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" ); + my $schema_name_actual = $schema_name || eapk_find_visible_schema($s); -my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' ); -is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" ); + $s->source('ExtAPK')->name($schema_name ? $schema_name.'.apk' : 'apk'); + #< clear sequence name cache + $s->source('ExtAPK')->column_info($_)->{sequence} = undef + for @eapk_id_columns; -my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' ); -is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" ); + no warnings 'uninitialized'; + lives_ok { + my $new; + for my $inc (1,2,3) { + $new = $schema->resultset('ExtAPK')->create({ id1 => 1}); + my $proper_seqval = ++$seqs{"$schema_name_actual.apk.id2"}; + is( $new->id2, $proper_seqval, "$schema_name_actual.apk.id2 correct inc $inc" ) + or eapk_seq_diag($s,$schema_name); + $new->discard_changes; + is( $new->id1, 1 ); + for my $id ('id3','id4') { + my $proper_seqval = ++$seqs{"$schema_name_actual.apk.$id"}; + is( $new->$id, $proper_seqval, "$schema_name_actual.apk.$id correct inc $inc" ) + or eapk_seq_diag($s,$schema_name); + } + } + } "create in schema '$schema_name' lives" + or eapk_seq_diag($s,$schema_name); +} -# Test SELECT ... FOR UPDATE -my $HaveSysSigAction = eval "require Sys::SigAction" && !$@; -if ($HaveSysSigAction) { - Sys::SigAction->import( 'set_sig_handler' ); +# print diagnostic info on which sequences were found in the ExtAPK +# class +sub eapk_seq_diag { + my $s = shift; + my $schema = shift || eapk_find_visible_schema($s); + + diag "$schema.apk sequences: ", + join(', ', + map "$_:".($s->source('ExtAPK')->column_info($_)->{sequence} || ''), + @eapk_id_columns + ); } -SKIP: { - skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction; - # create a new schema - my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); - $schema2->source("Artist")->name("testschema.artist"); - - $schema->txn_do( sub { - my $artist = $schema->resultset('Artist')->search( - { - artistid => 1 - }, - { - for => 'update' +# get the postgres search path as an arrayref +sub eapk_get_search_path { + my ( $s ) = @_; + # cache the search path as ['schema','schema',...] in the storage + # obj + + return $s->storage->dbh_do(sub { + my (undef, $dbh) = @_; + my @search_path; + my ($sp_string) = $dbh->selectrow_array('SHOW search_path'); + while ( $sp_string =~ s/("[^"]+"|[^,]+),?// ) { + unless( defined $1 and length $1 ) { + die "search path sanity check failed: '$1'"; } - )->first; - is($artist->artistid, 1, "select for update returns artistid = 1"); - - my $artist_from_schema2; - my $error_ok = 0; - eval { - my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } ); - alarm(2); - $artist_from_schema2 = $schema2->resultset('Artist')->find(1); - $artist_from_schema2->name('fooey'); - $artist_from_schema2->update; - alarm(0); - }; - if (my $e = $@) { - $error_ok = $e =~ /DBICTestTimeout/; + push @search_path, $1; } - - # Make sure that an error was raised, and that the update failed - ok($error_ok, "update from second schema times out"); - ok($artist_from_schema2->is_column_changed('name'), "'name' column is still dirty from second schema"); + \@search_path }); } +sub eapk_set_search_path { + my ($s,@sp) = @_; + my $sp = join ',',@sp; + $s->storage->dbh_do( sub { $_[1]->do("SET search_path = $sp") } ); +} + +# create the apk table in the given schema, can set whether the table name is qualified, what the nextval is for the second ID +sub eapk_create { + my ($schema, %a) = @_; + + $schema->storage->dbh_do(sub { + my (undef,$dbh) = @_; + + my $searchpath_save; + if ( $a{with_search_path} ) { + ($searchpath_save) = $dbh->selectrow_array('SHOW search_path'); + + my $search_path = join ',',map {/\D/ ? $_ : $eapk_schemas[$_]} @{$a{with_search_path}}; -SKIP: { - skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction; - # create a new schema - my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); - $schema2->source("Artist")->name("testschema.artist"); - - $schema->txn_do( sub { - my $artist = $schema->resultset('Artist')->search( - { - artistid => 1 - }, - )->first; - is($artist->artistid, 1, "select for update returns artistid = 1"); - - my $artist_from_schema2; - my $error_ok = 0; - eval { - my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } ); - alarm(2); - $artist_from_schema2 = $schema2->resultset('Artist')->find(1); - $artist_from_schema2->name('fooey'); - $artist_from_schema2->update; - alarm(0); - }; - if (my $e = $@) { - $error_ok = $e =~ /DBICTestTimeout/; + $dbh->do("SET search_path = $search_path"); } - # Make sure that an error was NOT raised, and that the update succeeded - ok(! $error_ok, "update from second schema DOES NOT timeout"); - ok(! $artist_from_schema2->is_column_changed('name'), "'name' column is NOT dirty from second schema"); + my $table_name = $a{qualify_table} + ? ($eapk_schemas[$a{qualify_table}] || die). ".apk" + : 'apk'; + local $_[1]->{Warn} = 0; + + my $id_def = $a{nextval} + ? "integer not null default nextval('$a{nextval}'::regclass)" + : 'serial'; + $dbh->do(<do("SET search_path = $searchpath_save"); + } }); } -for (1..5) { - my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); - is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key"); - is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key"); - is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key"); -} -my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); -is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually"); - -sub _cleanup { - my $dbh = shift or return; - - for my $stat ( - 'DROP TABLE testschema.artist', - 'DROP TABLE testschema.casecheck', - 'DROP TABLE testschema.sequence_test', - 'DROP TABLE testschema.array_test', - 'DROP SEQUENCE pkid1_seq', - 'DROP SEQUENCE pkid2_seq', - 'DROP SEQUENCE nonpkid_seq', - 'DROP SCHEMA testschema', - 'DROP TABLE anothertestschema.artist', - 'DROP SCHEMA anothertestschema', - 'DROP TABLE yetanothertestschema.artist', - 'DROP SCHEMA yetanothertestschema', - ) { - eval { $dbh->do ($stat) }; - } +sub eapk_drop_all { + my ( $schema, $warn_exceptions ) = @_; + + $schema->storage->dbh_do(sub { + my (undef,$dbh) = @_; + + local $dbh->{Warn} = 0; + + # drop the test schemas + for (@eapk_schemas ) { + eval{ $dbh->do("DROP SCHEMA $_ CASCADE") }; + diag $@ if $@ && $warn_exceptions; + } + + + }); } -END { _cleanup($dbh) } +sub eapk_find_visible_schema { + my ($s) = @_; + + my ($schema) = + $s->storage->dbh_do(sub { + $_[1]->selectrow_array(<