[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
{
    $schema->source("Artist")->name("dbic_t_schema.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| dbic_t_schema_2    1      |],
                         [qw| dbic_t_schema_3 1      |],
                       );
    foreach my $t ( @test_schemas ) {
        my ($sch_name, $start_num) = @$t;
        #test with dbic_t_schema_2
        $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| dbic_t_schema_4   2 |],
                        [qw| dbic_t_schema_5  1 |],
                       );

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

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