[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: 'testschema', 'anothertestschema', 'yetanothertestschema',
  'unq_nextval_schema', and 'unq_nextval_schema2'
)
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
{
    local $SIG{__WARN__} = sub {};
    _cleanup ($schema);

    $schema->source("Artist")->name("testschema.artist");

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

    is($unq_new && $unq_new->artistid, 1, "and got correct artistid");

    my @test_schemas = ( [qw| anothertestschema    1      |],
                         [qw| yetanothertestschema 1      |],
                       );
    foreach my $t ( @test_schemas ) {
        my ($sch_name, $start_num) = @$t;
        #test with anothertestschema
        $schema->source('Artist')->name("$sch_name.artist");
        $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
        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>');

    }


    my @todo_schemas = (
                        [qw| unq_nextval_schema   2 |],
                        [qw| unq_nextval_schema2  1 |],
                       );

    foreach my $t ( @todo_schemas ) {
        my ($sch_name, $start_num) = @$t;

        #test with anothertestschema
        $schema->source('Artist')->name("$sch_name.artist");
        $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
        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>');
    }

    $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
    $schema->source("Artist")->name($artist_name_save);
}

lives_ok {
    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';


### 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('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');


####### 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('testschema.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('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);
  }
}

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

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