[dbsrgits/DBIx-Class-Historic.git] / t / 72pg.t

use strict;
use warnings;

use Test::More;
use Test::Exception;
use lib qw(t/lib);
use DBICTest;


my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};

plan skip_all => <<EOM unless $dsn && $user;
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: 'dbic_t_schema', 'dbic_t_schema_2', 'dbic_t_schema_3',
  'dbic_t_schema_4', and 'dbic_t_schema_5'
)
EOM

### load any test classes that are defined further down in the file

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
{
  my $s = DBICTest::Schema->connect($dsn, $user, $pass);

  ok (!$s->storage->_dbh, 'definitely not connected');

  # 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 $s->storage;
      is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage');

      my $parser = $s->storage->datetime_parser;
      is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected');
  }


  # make sure sqlt_type overrides work (::Storage::DBI::Pg does this)
  is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection');
}

### connect, create postgres-specific test schema

my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
my $dbh = $schema->storage->dbh;

drop_test_schema($schema, 'no warn');
create_test_schema($schema);

### begin main tests

run_apk_tests($schema);


### 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};
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 'DBIx::Class';

  __PACKAGE__->load_components(qw/Core/);
  __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;

  lives_ok {
    $schema->resultset('ArrayTest')->create({
      arrayfield => [1, 2],
    });
  } 'inserting arrayref as pg array data';

  lives_ok {
    $schema->resultset('ArrayTest')->update({
      arrayfield => [3, 4],
    });
  } 'updating arrayref as pg array data';

  $schema->resultset('ArrayTest')->create({
    arrayfield => [5, 6],
  });

  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');
}


########## Case check

BEGIN {
  package DBICTest::Schema::Casecheck;
  push @main::test_classes, __PACKAGE__;

  use strict;
  use warnings;
  use base 'DBIx::Class';

  __PACKAGE__->load_components(qw/Core/);
  __PACKAGE__->table('dbic_t_schema.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);
  }
}

# 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'

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 SELECT ... FOR UPDATE

my $HaveSysSigAction = eval "require Sys::SigAction" && !$@;
if( $HaveSysSigAction ) {
    Sys::SigAction->import( 'set_sig_handler' );
}
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("dbic_t_schema.artist");

    $schema->txn_do( sub {
        my $artist = $schema->resultset('Artist')->search(
            {
                artistid => 1
            },
            {
                for => 'update'
            }
        )->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/;
        }

        # 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");
    });
}

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("dbic_t_schema.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/;
        }

        # 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");
    });
}


######## other 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, $_, "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");

done_testing;

exit;
END { drop_test_schema($schema) }


######### SUBROUTINES

sub create_test_schema {
    my $schema = shift;
    $schema->storage->dbh_do(sub {
      my (undef,$dbh) = @_;

      local $dbh->{Warn} = 0;

      my $std_artist_table = <<EOS;
(
  artistid serial PRIMARY KEY
  , name VARCHAR(100)
  , rank INTEGER NOT NULL DEFAULT '13'
  , charfield CHAR(10)
  , arrayfield INTEGER[]
)
EOS

      $dbh->do("CREATE SCHEMA dbic_t_schema");
      $dbh->do("CREATE TABLE dbic_t_schema.artist $std_artist_table");
      $dbh->do(<<EOS);
CREATE TABLE dbic_t_schema.sequence_test (
    pkid1 integer
    , pkid2 integer
    , nonpkid integer
    , name VARCHAR(100)
    , CONSTRAINT pk PRIMARY KEY(pkid1, pkid2)
)
EOS
      $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");
      $dbh->do(<<EOS);
CREATE TABLE dbic_t_schema.casecheck (
    id serial PRIMARY KEY
    , "name" VARCHAR(1)
    , "NAME" VARCHAR(2)
    , "UC_NAME" VARCHAR(3)
    , "storecolumn" VARCHAR(10)
)
EOS
      $dbh->do(<<EOS);
CREATE TABLE dbic_t_schema.array_test (
    id serial PRIMARY KEY
    , arrayfield INTEGER[]
)
EOS
      $dbh->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(<<EOS);
 CREATE TABLE dbic_t_schema_4.artist
 (
   artistid integer not null default nextval('artist_artistid_seq'::regclass) PRIMARY KEY
   , name VARCHAR(100)
   , rank INTEGER NOT NULL DEFAULT '13'
   , charfield CHAR(10)
   , arrayfield INTEGER[]
 );
EOS
      $dbh->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(<<EOS);
 CREATE TABLE dbic_t_schema_5.artist
 (
   artistid integer not null default nextval('public.artist_artistid_seq'::regclass) PRIMARY KEY
   , name VARCHAR(100)
   , rank INTEGER NOT NULL DEFAULT '13'
   , charfield CHAR(10)
   , arrayfield INTEGER[]
 );
EOS
      $dbh->do('set search_path=dbic_t_schema,public');
  });
}


sub drop_test_schema {
    my ( $schema, $no_warn ) = @_;

    $schema->storage->dbh_do(sub {
        my (undef,$dbh) = @_;

        local $dbh->{Warn} = 0;

        for my $stat (
                      'DROP SCHEMA dbic_t_schema_5 CASCADE',
                      'DROP SEQUENCE public.artist_artistid_seq',
                      'DROP SCHEMA dbic_t_schema_4 CASCADE',
                      'DROP SCHEMA dbic_t_schema CASCADE',
                      'DROP SEQUENCE pkid1_seq',
                      'DROP SEQUENCE pkid2_seq',
                      'DROP SEQUENCE nonpkid_seq',
                      'DROP SCHEMA dbic_t_schema_2 CASCADE',
                      'DROP SCHEMA dbic_t_schema_3 CASCADE',
                     ) {
            eval { $dbh->do ($stat) };
            diag $@ if $@ && !$no_warn;
        }
    });
}

###  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} || '<none>');
        } "$sch_name liid 1 did not die"
            or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
        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} || '<none>');
        } "$sch_name liid 2 did not die"
            or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');

    }

    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
}
Commit	Line	Data
70350518	1	use strict;
4617b792	2	use warnings;
70350518	3
70350518	4	use Test::More;
9ba627e3	5	use Test::Exception;
70350518	6	use lib qw(t/lib);
	7	use DBICTest;
	8
89add887	9
0567538f	10	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
0567538f	11
609c5f1b	12	plan skip_all => <<EOM unless $dsn && $user;
	13	Set \$ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test
	14	( NOTE: This test drops and creates tables called 'artist', 'casecheck',
	15	'array_test' and 'sequence_test' as well as following sequences:
	16	'pkid1_seq', 'pkid2_seq' and 'nonpkid_seq''. as well as following
881def48	17	schemas: 'dbic_t_schema', 'dbic_t_schema_2', 'dbic_t_schema_3',
881def48	18	'dbic_t_schema_4', and 'dbic_t_schema_5'
609c5f1b	19	)
609c5f1b	20	EOM
0567538f	21
70a201a5	22	### load any test classes that are defined further down in the file
efd38994	23
70a201a5	24	our @test_classes; #< array that will be pushed into by test classes defined in this file
70a201a5	25	DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes;
efd38994	26
efd38994	27
70a201a5	28	### pre-connect tests
eabde904	29	{
70a201a5	30	my $s = DBICTest::Schema->connect($dsn, $user, $pass);
eabde904	31
70a201a5	32	ok (!$s->storage->_dbh, 'definitely not connected');
eabde904	33
70a201a5	34	# Check that datetime_parser returns correctly before we explicitly connect.
	35	SKIP: {
	36	eval { require DateTime::Format::Pg };
	37	skip "DateTime::Format::Pg required", 2 if $@;
114780ee	38
70a201a5	39	my $store = ref $s->storage;
70a201a5	40	is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage');
114780ee	41
70a201a5	42	my $parser = $s->storage->datetime_parser;
	43	is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected');
	44	}
114780ee	45
609c5f1b	46
70a201a5	47	# make sure sqlt_type overrides work (::Storage::DBI::Pg does this)
70a201a5	48	is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection');
bb452615	49	}
0567538f	50
70a201a5	51	### connect, create postgres-specific test schema
c3af542a	52
70a201a5	53	my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
70a201a5	54	my $dbh = $schema->storage->dbh;
c3af542a	55
2fbf50ff	56	drop_test_schema($schema, 'no warn');
2fbf50ff	57	create_test_schema($schema);
609c5f1b	58
70a201a5	59	### begin main tests
4617b792	60
ee9f372c	61	run_apk_tests($schema);
b6b65a3e	62
70a201a5	63
	64	### type_info tests
	65
a953d8d9	66	my $test_type_info = {
a953d8d9	67	'artistid' => {
103e3e03	68	'data_type' => 'integer',
103e3e03	69	'is_nullable' => 0,
fc22fbac	70	'size' => 4,
a953d8d9	71	},
a953d8d9	72	'name' => {
103e3e03	73	'data_type' => 'character varying',
103e3e03	74	'is_nullable' => 1,
ae515736	75	'size' => 100,
fc22fbac	76	'default_value' => undef,
103e3e03	77	},
85df19d7	78	'rank' => {
	79	'data_type' => 'integer',
	80	'is_nullable' => 0,
	81	'size' => 4,
	82	'default_value' => 13,
	83
	84	},
103e3e03	85	'charfield' => {
103e3e03	86	'data_type' => 'character',
a953d8d9	87	'is_nullable' => 1,
fc22fbac	88	'size' => 10,
fc22fbac	89	'default_value' => undef,
103e3e03	90	},
9ba627e3	91	'arrayfield' => {
	92	'data_type' => 'integer[]',
	93	'is_nullable' => 1,
	94	'size' => undef,
	95	'default_value' => undef,
	96	},
a953d8d9	97	};
a953d8d9	98
881def48	99	my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist');
fc22fbac	100	my $artistid_defval = delete $type_info->{artistid}->{default_value};
fc22fbac	101	like($artistid_defval,
4d272ce5	102	qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text\|regclass)\)/,
fc22fbac	103	'columns_info_for - sequence matches Pg get_autoinc_seq expectations');
	104	is_deeply($type_info, $test_type_info,
	105	'columns_info_for - column data types');
a953d8d9	106
70a201a5	107
	108
	109
	110	####### Array tests
	111
	112	BEGIN {
	113	package DBICTest::Schema::ArrayTest;
	114	push @main::test_classes, __PACKAGE__;
	115
	116	use strict;
	117	use warnings;
	118	use base 'DBIx::Class';
	119
	120	__PACKAGE__->load_components(qw/Core/);
881def48	121	__PACKAGE__->table('dbic_t_schema.array_test');
70a201a5	122	__PACKAGE__->add_columns(qw/id arrayfield/);
	123	__PACKAGE__->column_info_from_storage(1);
	124	__PACKAGE__->set_primary_key('id');
	125
	126	}
ac45262b	127	SKIP: {
	128	skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002;
	129
9ba627e3	130	lives_ok {
	131	$schema->resultset('ArrayTest')->create({
	132	arrayfield => [1, 2],
	133	});
	134	} 'inserting arrayref as pg array data';
	135
	136	lives_ok {
	137	$schema->resultset('ArrayTest')->update({
	138	arrayfield => [3, 4],
	139	});
	140	} 'updating arrayref as pg array data';
c224117b	141
	142	$schema->resultset('ArrayTest')->create({
	143	arrayfield => [5, 6],
	144	});
	145
	146	my $count;
	147	lives_ok {
	148	$count = $schema->resultset('ArrayTest')->search({
aab0d3b7	149	arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ], #Todo anything less ugly than this?
c224117b	150	})->count;
	151	} 'comparing arrayref to pg array data does not blow up';
	152	is($count, 1, 'comparing arrayref to pg array data gives correct result');
9ba627e3	153	}
	154
	155
70a201a5	156
	157	########## Case check
	158
	159	BEGIN {
	160	package DBICTest::Schema::Casecheck;
	161	push @main::test_classes, __PACKAGE__;
	162
	163	use strict;
	164	use warnings;
	165	use base 'DBIx::Class';
	166
	167	__PACKAGE__->load_components(qw/Core/);
881def48	168	__PACKAGE__->table('dbic_t_schema.casecheck');
70a201a5	169	__PACKAGE__->add_columns(qw/id name NAME uc_name storecolumn/);
	170	__PACKAGE__->column_info_from_storage(1);
	171	__PACKAGE__->set_primary_key('id');
	172
	173	sub store_column {
	174	my ($self, $name, $value) = @_;
	175	$value = '#'.$value if($name eq "storecolumn");
	176	$self->maybe::next::method($name, $value);
	177	}
	178	}
	179
efd38994	180	# store_column is called once for create() for non sequence columns
	181	ok(my $storecolumn = $schema->resultset('Casecheck')->create({'storecolumn' => 'a'}));
	182	is($storecolumn->storecolumn, '#a'); # was '##a'
	183
3ff5b740	184	my $name_info = $schema->source('Casecheck')->column_info( 'name' );
ae515736	185	is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" );
ae515736	186
3ff5b740	187	my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' );
ae515736	188	is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" );
ae515736	189
3ff5b740	190	my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' );
ae515736	191	is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" );
ae515736	192
70a201a5	193
	194
	195
	196	## Test SELECT ... FOR UPDATE
	197
95ba7ee4	198	my $HaveSysSigAction = eval "require Sys::SigAction" && !$@;
70a201a5	199	if( $HaveSysSigAction ) {
95ba7ee4	200	Sys::SigAction->import( 'set_sig_handler' );
95ba7ee4	201	}
95ba7ee4	202	SKIP: {
	203	skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
	204	# create a new schema
	205	my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
881def48	206	$schema2->source("Artist")->name("dbic_t_schema.artist");
95ba7ee4	207
	208	$schema->txn_do( sub {
	209	my $artist = $schema->resultset('Artist')->search(
	210	{
	211	artistid => 1
	212	},
	213	{
	214	for => 'update'
	215	}
	216	)->first;
	217	is($artist->artistid, 1, "select for update returns artistid = 1");
	218
	219	my $artist_from_schema2;
	220	my $error_ok = 0;
	221	eval {
	222	my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
	223	alarm(2);
	224	$artist_from_schema2 = $schema2->resultset('Artist')->find(1);
	225	$artist_from_schema2->name('fooey');
	226	$artist_from_schema2->update;
	227	alarm(0);
	228	};
	229	if (my $e = $@) {
	230	$error_ok = $e =~ /DBICTestTimeout/;
	231	}
	232
	233	# Make sure that an error was raised, and that the update failed
	234	ok($error_ok, "update from second schema times out");
	235	ok($artist_from_schema2->is_column_changed('name'), "'name' column is still dirty from second schema");
	236	});
	237	}
	238
	239	SKIP: {
	240	skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
	241	# create a new schema
	242	my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
881def48	243	$schema2->source("Artist")->name("dbic_t_schema.artist");
95ba7ee4	244
	245	$schema->txn_do( sub {
	246	my $artist = $schema->resultset('Artist')->search(
	247	{
	248	artistid => 1
	249	},
	250	)->first;
	251	is($artist->artistid, 1, "select for update returns artistid = 1");
	252
	253	my $artist_from_schema2;
	254	my $error_ok = 0;
	255	eval {
	256	my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
	257	alarm(2);
	258	$artist_from_schema2 = $schema2->resultset('Artist')->find(1);
	259	$artist_from_schema2->name('fooey');
	260	$artist_from_schema2->update;
	261	alarm(0);
	262	};
	263	if (my $e = $@) {
	264	$error_ok = $e =~ /DBICTestTimeout/;
	265	}
	266
	267	# Make sure that an error was NOT raised, and that the update succeeded
	268	ok(! $error_ok, "update from second schema DOES NOT timeout");
	269	ok(! $artist_from_schema2->is_column_changed('name'), "'name' column is NOT dirty from second schema");
	270	});
	271	}
	272
70a201a5	273
	274	######## other Auto-pk tests
	275
881def48	276	$schema->source("SequenceTest")->name("dbic_t_schema.sequence_test");
d093d3eb	277	for (1..5) {
39b8d119	278	my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
	279	is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key");
	280	is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key");
	281	is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key");
d093d3eb	282	}
	283	my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
	284	is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
	285
2fbf50ff	286	done_testing;
609c5f1b	287
70a201a5	288	exit;
2fbf50ff	289	END { drop_test_schema($schema) }
70a201a5	290
	291
	292	######### SUBROUTINES
	293
	294	sub create_test_schema {
2fbf50ff	295	my $schema = shift;
	296	$schema->storage->dbh_do(sub {
	297	my (undef,$dbh) = @_;
70a201a5	298
2fbf50ff	299	local $dbh->{Warn} = 0;
70a201a5	300
2fbf50ff	301	my $std_artist_table = <<EOS;
70a201a5	302	(
	303	artistid serial PRIMARY KEY
	304	, name VARCHAR(100)
	305	, rank INTEGER NOT NULL DEFAULT '13'
	306	, charfield CHAR(10)
	307	, arrayfield INTEGER[]
	308	)
	309	EOS
	310
881def48	311	$dbh->do("CREATE SCHEMA dbic_t_schema");
881def48	312	$dbh->do("CREATE TABLE dbic_t_schema.artist $std_artist_table");
2fbf50ff	313	$dbh->do(<<EOS);
881def48	314	CREATE TABLE dbic_t_schema.sequence_test (
70a201a5	315	pkid1 integer
	316	, pkid2 integer
	317	, nonpkid integer
	318	, name VARCHAR(100)
	319	, CONSTRAINT pk PRIMARY KEY(pkid1, pkid2)
	320	)
	321	EOS
2fbf50ff	322	$dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
	323	$dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
	324	$dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
	325	$dbh->do(<<EOS);
881def48	326	CREATE TABLE dbic_t_schema.casecheck (
70a201a5	327	id serial PRIMARY KEY
	328	, "name" VARCHAR(1)
	329	, "NAME" VARCHAR(2)
	330	, "UC_NAME" VARCHAR(3)
	331	, "storecolumn" VARCHAR(10)
	332	)
	333	EOS
2fbf50ff	334	$dbh->do(<<EOS);
881def48	335	CREATE TABLE dbic_t_schema.array_test (
70a201a5	336	id serial PRIMARY KEY
	337	, arrayfield INTEGER[]
	338	)
	339	EOS
881def48	340	$dbh->do("CREATE SCHEMA dbic_t_schema_2");
	341	$dbh->do("CREATE TABLE dbic_t_schema_2.artist $std_artist_table");
	342	$dbh->do("CREATE SCHEMA dbic_t_schema_3");
	343	$dbh->do("CREATE TABLE dbic_t_schema_3.artist $std_artist_table");
	344	$dbh->do('set search_path=dbic_t_schema,public');
	345	$dbh->do("CREATE SCHEMA dbic_t_schema_4");
	346	$dbh->do("CREATE SCHEMA dbic_t_schema_5");
2fbf50ff	347	$dbh->do(<<EOS);
881def48	348	CREATE TABLE dbic_t_schema_4.artist
70a201a5	349	(
	350	artistid integer not null default nextval('artist_artistid_seq'::regclass) PRIMARY KEY
	351	, name VARCHAR(100)
	352	, rank INTEGER NOT NULL DEFAULT '13'
	353	, charfield CHAR(10)
	354	, arrayfield INTEGER[]
	355	);
	356	EOS
881def48	357	$dbh->do('set search_path=public,dbic_t_schema,dbic_t_schema_3');
2fbf50ff	358	$dbh->do('create sequence public.artist_artistid_seq'); #< in the public schema
2fbf50ff	359	$dbh->do(<<EOS);
881def48	360	CREATE TABLE dbic_t_schema_5.artist
70a201a5	361	(
	362	artistid integer not null default nextval('public.artist_artistid_seq'::regclass) PRIMARY KEY
	363	, name VARCHAR(100)
	364	, rank INTEGER NOT NULL DEFAULT '13'
	365	, charfield CHAR(10)
	366	, arrayfield INTEGER[]
	367	);
	368	EOS
881def48	369	$dbh->do('set search_path=dbic_t_schema,public');
2fbf50ff	370	});
70a201a5	371	}
	372
	373
	374
	375	sub drop_test_schema {
2fbf50ff	376	my ( $schema, $no_warn ) = @_;
	377
	378	$schema->storage->dbh_do(sub {
	379	my (undef,$dbh) = @_;
	380
	381	local $dbh->{Warn} = 0;
	382
	383	for my $stat (
881def48	384	'DROP SCHEMA dbic_t_schema_5 CASCADE',
2fbf50ff	385	'DROP SEQUENCE public.artist_artistid_seq',
881def48	386	'DROP SCHEMA dbic_t_schema_4 CASCADE',
881def48	387	'DROP SCHEMA dbic_t_schema CASCADE',
2fbf50ff	388	'DROP SEQUENCE pkid1_seq',
	389	'DROP SEQUENCE pkid2_seq',
	390	'DROP SEQUENCE nonpkid_seq',
881def48	391	'DROP SCHEMA dbic_t_schema_2 CASCADE',
881def48	392	'DROP SCHEMA dbic_t_schema_3 CASCADE',
2fbf50ff	393	) {
	394	eval { $dbh->do ($stat) };
	395	diag $@ if $@ && !$no_warn;
	396	}
	397	});
3ff5b740	398	}
7603d2a5	399
ee9f372c	400	### auto-pk / last_insert_id / sequence discovery
	401	sub run_apk_tests {
	402	my $schema = shift;
	403
	404	# This is in Core now, but it's here just to test that it doesn't break
	405	$schema->class('Artist')->load_components('PK::Auto');
	406	cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table');
	407
	408	# test that auto-pk also works with the defined search path by
	409	# un-schema-qualifying the table name
	410	apk_t_set($schema,'artist');
	411
	412	my $unq_new;
	413	lives_ok {
	414	$unq_new = $schema->resultset('Artist')->create({ name => 'baz' });
	415	} 'insert into unqualified, shadowed table succeeds';
	416
	417	is($unq_new && $unq_new->artistid, 1, "and got correct artistid");
	418
	419	my @test_schemas = ( [qw\| dbic_t_schema_2 1 \|],
	420	[qw\| dbic_t_schema_3 1 \|],
	421	[qw\| dbic_t_schema_4 2 \|],
	422	[qw\| dbic_t_schema_5 1 \|],
	423	);
	424	foreach my $t ( @test_schemas ) {
	425	my ($sch_name, $start_num) = @$t;
	426	#test with dbic_t_schema_2
	427	apk_t_set($schema,"$sch_name.artist");
	428	my $another_new;
	429	lives_ok {
	430	$another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
	431	is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
	432	or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} \|\| '<none>');
	433	} "$sch_name liid 1 did not die"
	434	or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} \|\| '<none>');
	435	lives_ok {
	436	$another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
	437	is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
	438	or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} \|\| '<none>');
	439	} "$sch_name liid 2 did not die"
	440	or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} \|\| '<none>');
	441
	442	}
	443
	444	lives_ok {
	445	apk_t_set($schema,'dbic_t_schema.artist');
	446	my $new = $schema->resultset('Artist')->create({ name => 'foo' });
	447	is($new->artistid, 4, "Auto-PK worked");
	448	$new = $schema->resultset('Artist')->create({ name => 'bar' });
	449	is($new->artistid, 5, "Auto-PK worked");
	450	} 'old auto-pk tests did not die either';
	451	}
	452
	453
	454	# sets the artist table name and clears sequence name cache
	455	sub apk_t_set {
	456	my ( $s, $n ) = @_;
	457	$s->source("Artist")->name($n);
	458	$s->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
	459	}
	460