[dbsrgits/DBIx-Class.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

###  auto-pk / last_insert_id / sequence discovery
{
    # 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
}


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

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