[dbsrgits/DBIx-Class.git] / t / 746sybase.t

use strict;
use warnings;
no warnings 'uninitialized';

use Test::More;
use Test::Exception;
use DBIx::Class::Optional::Dependencies ();
use lib qw(t/lib);
use DBICTest;

my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
if (not ($dsn && $user)) {
  plan skip_all => join ' ',
    'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test.',
    'Warning: This test drops and creates the tables:',
    "'artist', 'money_test' and 'bindtype_test'",
  ;
};

plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ase')
  unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ase');

my @storage_types = (
  'DBI::Sybase::ASE',
  'DBI::Sybase::ASE::NoBindVars',
);
eval "require DBIx::Class::Storage::$_;" for @storage_types;

my $schema;
my $storage_idx = -1;

sub get_schema {
  DBICTest::Schema->connect($dsn, $user, $pass, {
    on_connect_call => [
      [ blob_setup => log_on_update => 1 ], # this is a safer option
    ],
  });
}

my $ping_count = 0;
{
  my $ping = DBIx::Class::Storage::DBI::Sybase::ASE->can('_ping');
  *DBIx::Class::Storage::DBI::Sybase::ASE::_ping = sub {
    $ping_count++;
    goto $ping;
  };
}

for my $storage_type (@storage_types) {
  $storage_idx++;

  unless ($storage_type eq 'DBI::Sybase::ASE') { # autodetect
    DBICTest::Schema->storage_type("::$storage_type");
  }

  $schema = get_schema();

  $schema->storage->ensure_connected;

  if ($storage_idx == 0 &&
      $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars')) {
      # no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS)
      skip "Skipping entire test for $storage_type - no placeholder support", 1;
      next;
  }

  isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" );

  $schema->storage->_dbh->disconnect;
  lives_ok (sub { $schema->storage->dbh }, 'reconnect works');

  $schema->storage->dbh_do (sub {
      my ($storage, $dbh) = @_;
      eval { $dbh->do("DROP TABLE artist") };
      $dbh->do(<<'SQL');
CREATE TABLE artist (
   artistid INT IDENTITY PRIMARY KEY,
   name VARCHAR(100),
   rank INT DEFAULT 13 NOT NULL,
   charfield CHAR(10) NULL
)
SQL
  });

  my %seen_id;

# so we start unconnected
  $schema->storage->disconnect;

# test primary key handling
  my $new = $schema->resultset('Artist')->create({ name => 'foo' });
  ok($new->artistid > 0, "Auto-PK worked");

  $seen_id{$new->artistid}++;

# check redispatch to storage-specific insert when auto-detected storage
  if ($storage_type eq 'DBI::Sybase::ASE') {
    DBICTest::Schema->storage_type('::DBI');
    $schema = get_schema();
  }

  $new = $schema->resultset('Artist')->create({ name => 'Artist 1' });
  is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' );
  $seen_id{$new->artistid}++;

# inserts happen in a txn, so we make sure it still works inside a txn too
  $schema->txn_begin;

  for (2..6) {
    $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
    is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
    $seen_id{$new->artistid}++;
  }

  $schema->txn_commit;

# test simple count
  is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok');

# test LIMIT support
  my $it = $schema->resultset('Artist')->search({
    artistid => { '>' => 0 }
  }, {
    rows => 3,
    order_by => 'artistid',
  });

  is( $it->count, 3, "LIMIT count ok" );

  is( $it->next->name, "foo", "iterator->next ok" );
  $it->next;
  is( $it->next->name, "Artist 2", "iterator->next ok" );
  is( $it->next, undef, "next past end of resultset ok" );

# now try with offset
  $it = $schema->resultset('Artist')->search({}, {
    rows => 3,
    offset => 3,
    order_by => 'artistid',
  });

  is( $it->count, 3, "LIMIT with offset count ok" );

  is( $it->next->name, "Artist 3", "iterator->next ok" );
  $it->next;
  is( $it->next->name, "Artist 5", "iterator->next ok" );
  is( $it->next, undef, "next past end of resultset ok" );

# now try a grouped count
  $schema->resultset('Artist')->create({ name => 'Artist 6' })
    for (1..6);

  $it = $schema->resultset('Artist')->search({}, {
    group_by => 'name'
  });

  is( $it->count, 7, 'COUNT of GROUP_BY ok' );

# do an IDENTITY_INSERT
  {
    no warnings 'redefine';

    my @debug_out;
    local $schema->storage->{debug} = 1;
    local $schema->storage->debugobj->{callback} = sub {
      push @debug_out, $_[1];
    };

    my $txn_used = 0;
    my $txn_commit = \&DBIx::Class::Storage::DBI::txn_commit;
    local *DBIx::Class::Storage::DBI::txn_commit = sub {
      $txn_used = 1;
      goto &$txn_commit;
    };

    $schema->resultset('Artist')
      ->create({ artistid => 999, name => 'mtfnpy' });

    ok((grep /IDENTITY_INSERT/i, @debug_out), 'IDENTITY_INSERT used');

    SKIP: {
      skip 'not testing lack of txn on IDENTITY_INSERT with NoBindVars', 1
        if $storage_type =~ /NoBindVars/i;

      is $txn_used, 0, 'no txn on insert with IDENTITY_INSERT';
    }
  }

# do an IDENTITY_UPDATE
  {
    my @debug_out;
    local $schema->storage->{debug} = 1;
    local $schema->storage->debugobj->{callback} = sub {
      push @debug_out, $_[1];
    };

    lives_and {
      $schema->resultset('Artist')
        ->find(999)->update({ artistid => 555 });
      ok((grep /IDENTITY_UPDATE/i, @debug_out));
    } 'IDENTITY_UPDATE used';
    $ping_count-- if $@;
  }

  my $bulk_rs = $schema->resultset('Artist')->search({
    name => { -like => 'bulk artist %' }
  });

# test insert_bulk using populate.
  SKIP: {
    skip 'insert_bulk not supported', 4
      unless $storage_type !~ /NoBindVars/i;

    lives_ok {
      $schema->resultset('Artist')->populate([
        {
          name => 'bulk artist 1',
          charfield => 'foo',
        },
        {
          name => 'bulk artist 2',
          charfield => 'foo',
        },
        {
          name => 'bulk artist 3',
          charfield => 'foo',
        },
      ]);
    } 'insert_bulk via populate';

    is $bulk_rs->count, 3, 'correct number inserted via insert_bulk';

    is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
      'column set correctly via insert_bulk');

    my %bulk_ids;
    @bulk_ids{map $_->artistid, $bulk_rs->all} = ();

    is ((scalar keys %bulk_ids), 3,
      'identities generated correctly in insert_bulk');

    $bulk_rs->delete;
  }

# make sure insert_bulk works a second time on the same connection
  SKIP: {
    skip 'insert_bulk not supported', 3
      unless $storage_type !~ /NoBindVars/i;

    lives_ok {
      $schema->resultset('Artist')->populate([
        {
          name => 'bulk artist 1',
          charfield => 'bar',
        },
        {
          name => 'bulk artist 2',
          charfield => 'bar',
        },
        {
          name => 'bulk artist 3',
          charfield => 'bar',
        },
      ]);
    } 'insert_bulk via populate called a second time';

    is $bulk_rs->count, 3,
      'correct number inserted via insert_bulk';

    is ((grep $_->charfield eq 'bar', $bulk_rs->all), 3,
      'column set correctly via insert_bulk');

    $bulk_rs->delete;
  }

# test invalid insert_bulk (missing required column)
#
# There should be a rollback, reconnect and the next valid insert_bulk should
# succeed.
  throws_ok {
    $schema->resultset('Artist')->populate([
      {
        charfield => 'foo',
      }
    ]);
  } qr/no value or default|does not allow null|placeholders/i,
# The second pattern is the error from fallback to regular array insert on
# incompatible charset.
# The third is for ::NoBindVars with no syb_has_blk.
  'insert_bulk with missing required column throws error';

# now test insert_bulk with IDENTITY_INSERT
  SKIP: {
    skip 'insert_bulk not supported', 3
      unless $storage_type !~ /NoBindVars/i;

    lives_ok {
      $schema->resultset('Artist')->populate([
        {
          artistid => 2001,
          name => 'bulk artist 1',
          charfield => 'foo',
        },
        {
          artistid => 2002,
          name => 'bulk artist 2',
          charfield => 'foo',
        },
        {
          artistid => 2003,
          name => 'bulk artist 3',
          charfield => 'foo',
        },
      ]);
    } 'insert_bulk with IDENTITY_INSERT via populate';

    is $bulk_rs->count, 3,
      'correct number inserted via insert_bulk with IDENTITY_INSERT';

    is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
      'column set correctly via insert_bulk with IDENTITY_INSERT');

    $bulk_rs->delete;
  }

# test correlated subquery
  my $subq = $schema->resultset('Artist')->search({ artistid => { '>' => 3 } })
    ->get_column('artistid')
    ->as_query;
  my $subq_rs = $schema->resultset('Artist')->search({
    artistid => { -in => $subq }
  });
  is $subq_rs->count, 11, 'correlated subquery';

# mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
  SKIP: {
    skip 'TEXT/IMAGE support does not work with FreeTDS', 22
      if $schema->storage->_using_freetds;

    my $dbh = $schema->storage->_dbh;
    {
      local $SIG{__WARN__} = sub {};
      eval { $dbh->do('DROP TABLE bindtype_test') };

      $dbh->do(qq[
        CREATE TABLE bindtype_test
        (
          id     INT   IDENTITY PRIMARY KEY,
          bytea  IMAGE NULL,
          blob   IMAGE NULL,
          clob   TEXT  NULL,
          a_memo IMAGE NULL
        )
      ],{ RaiseError => 1, PrintError => 0 });
    }

    my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
    $binstr{'large'} = $binstr{'small'} x 1024;

    my $maxloblen = length $binstr{'large'};

    if (not $schema->storage->_using_freetds) {
      $dbh->{'LongReadLen'} = $maxloblen * 2;
    } else {
      $dbh->do("set textsize ".($maxloblen * 2));
    }

    my $rs = $schema->resultset('BindType');
    my $last_id;

    foreach my $type (qw(blob clob)) {
      foreach my $size (qw(small large)) {
        no warnings 'uninitialized';

        my $created;
        lives_ok {
          $created = $rs->create( { $type => $binstr{$size} } )
        } "inserted $size $type without dying";

        $last_id = $created->id if $created;

        lives_and {
          ok($rs->find($last_id)->$type eq $binstr{$size})
        } "verified inserted $size $type";
      }
    }

    $rs->delete;

    # blob insert with explicit PK
    # also a good opportunity to test IDENTITY_INSERT
    lives_ok {
      $rs->create( { id => 1, blob => $binstr{large} } )
    } 'inserted large blob without dying with manual PK';

    lives_and {
      ok($rs->find(1)->blob eq $binstr{large})
    } 'verified inserted large blob with manual PK';

    # try a blob update
    my $new_str = $binstr{large} . 'mtfnpy';

    # check redispatch to storage-specific update when auto-detected storage
    if ($storage_type eq 'DBI::Sybase::ASE') {
      DBICTest::Schema->storage_type('::DBI');
      $schema = get_schema();
    }

    lives_ok {
      $rs->search({ id => 1 })->update({ blob => $new_str })
    } 'updated blob successfully';

    lives_and {
      ok($rs->find(1)->blob eq $new_str)
    } 'verified updated blob';

    # try a blob update with IDENTITY_UPDATE
    lives_and {
      $new_str = $binstr{large} . 'hlagh';
      $rs->find(1)->update({ id => 999, blob => $new_str });
      ok($rs->find(999)->blob eq $new_str);
    } 'verified updated blob with IDENTITY_UPDATE';

    ## try multi-row blob update
    # first insert some blobs
    $new_str = $binstr{large} . 'foo';
    lives_and {
      $rs->delete;
      $rs->create({ blob => $binstr{large} }) for (1..2);
      $rs->update({ blob => $new_str });
      is((grep $_->blob eq $new_str, $rs->all), 2);
    } 'multi-row blob update';

    $rs->delete;

    # now try insert_bulk with blobs and only blobs
    $new_str = $binstr{large} . 'bar';
    lives_ok {
      $rs->populate([
        {
          blob => $binstr{large},
          clob => $new_str,
        },
        {
          blob => $binstr{large},
          clob => $new_str,
        },
      ]);
    } 'insert_bulk with blobs does not die';

    is((grep $_->blob eq $binstr{large}, $rs->all), 2,
      'IMAGE column set correctly via insert_bulk');

    is((grep $_->clob eq $new_str, $rs->all), 2,
      'TEXT column set correctly via insert_bulk');

    # now try insert_bulk with blobs and a non-blob which also happens to be an
    # identity column
    SKIP: {
      skip 'no insert_bulk without placeholders', 4
        if $storage_type =~ /NoBindVars/i;

      $rs->delete;
      $new_str = $binstr{large} . 'bar';
      lives_ok {
        $rs->populate([
          {
            id => 1,
            bytea => 1,
            blob => $binstr{large},
            clob => $new_str,
            a_memo => 2,
          },
          {
            id => 2,
            bytea => 1,
            blob => $binstr{large},
            clob => $new_str,
            a_memo => 2,
          },
        ]);
      } 'insert_bulk with blobs and explicit identity does NOT die';

      is((grep $_->blob eq $binstr{large}, $rs->all), 2,
        'IMAGE column set correctly via insert_bulk with identity');

      is((grep $_->clob eq $new_str, $rs->all), 2,
        'TEXT column set correctly via insert_bulk with identity');

      is_deeply [ map $_->id, $rs->all ], [ 1,2 ],
        'explicit identities set correctly via insert_bulk with blobs';
    }

    lives_and {
      $rs->delete;
      $rs->create({ blob => $binstr{large} }) for (1..2);
      $rs->update({ blob => undef });
      is((grep !defined($_->blob), $rs->all), 2);
    } 'blob update to NULL';
  }

# test MONEY column support (and some other misc. stuff)
  $schema->storage->dbh_do (sub {
      my ($storage, $dbh) = @_;
      eval { $dbh->do("DROP TABLE money_test") };
      $dbh->do(<<'SQL');
CREATE TABLE money_test (
   id INT IDENTITY PRIMARY KEY,
   amount MONEY DEFAULT $999.99 NULL
)
SQL
  });

  my $rs = $schema->resultset('Money');

# test insert with defaults
  lives_and {
    $rs->create({});
    is((grep $_->amount == 999.99, $rs->all), 1);
  } 'insert with all defaults works';
  $rs->delete;

# test insert transaction when there's an active cursor
  {
    my $artist_rs = $schema->resultset('Artist');
    $artist_rs->first;
    lives_ok {
      my $row = $schema->resultset('Money')->create({ amount => 100 });
      $row->delete;
    } 'inserted a row with an active cursor';
    $ping_count-- if $@; # dbh_do calls ->connected
  }

# test insert in an outer transaction when there's an active cursor
  TODO: {
    local $TODO = 'this should work once we have eager cursors';

# clear state, or we get a deadlock on $row->delete
# XXX figure out why this happens
    $schema->storage->disconnect;

    lives_ok {
      $schema->txn_do(sub {
        my $artist_rs = $schema->resultset('Artist');
        $artist_rs->first;
        my $row = $schema->resultset('Money')->create({ amount => 100 });
        $row->delete;
      });
    } 'inserted a row with an active cursor in outer txn';
    $ping_count-- if $@; # dbh_do calls ->connected
  }

# Now test money values.
  my $row;
  lives_ok {
    $row = $rs->create({ amount => 100 });
  } 'inserted a money value';

  cmp_ok eval { $rs->find($row->id)->amount }, '==', 100,
    'money value round-trip';

  lives_ok {
    $row->update({ amount => 200 });
  } 'updated a money value';

  cmp_ok eval { $rs->find($row->id)->amount }, '==', 200,
    'updated money value round-trip';

  lives_ok {
    $row->update({ amount => undef });
  } 'updated a money value to NULL';

  lives_and {
    my $null_amount = $rs->find($row->id)->amount;
    is $null_amount, undef;
  } 'updated money value to NULL round-trip';

# Test computed columns and timestamps
  $schema->storage->dbh_do (sub {
      my ($storage, $dbh) = @_;
      eval { $dbh->do("DROP TABLE computed_column_test") };
      $dbh->do(<<'SQL');
CREATE TABLE computed_column_test (
   id INT IDENTITY PRIMARY KEY,
   a_computed_column AS getdate(),
   a_timestamp timestamp,
   charfield VARCHAR(20) DEFAULT 'foo'
)
SQL
  });

  require DBICTest::Schema::ComputedColumn;
  $schema->register_class(
    ComputedColumn => 'DBICTest::Schema::ComputedColumn'
  );

  ok (($rs = $schema->resultset('ComputedColumn')),
    'got rs for ComputedColumn');

  lives_ok { $row = $rs->create({}) }
    'empty insert for a table with computed columns survived';

  lives_ok {
    $row->update({ charfield => 'bar' })
  } 'update of a table with computed columns survived';
}

is $ping_count, 0, 'no pings';

# if tests passed and did so under a non-C lang - let's rerun the test
if (Test::Builder->new->is_passing and $ENV{LANG} and $ENV{LANG} ne 'C') {
  my $oldlang = $ENV{LANG};
  local $ENV{LANG} = 'C';

  pass ("Your lang is set to $oldlang - retesting with C");

  my @cmd = ($^X, __FILE__);

  # this is cheating, and may even hang here and there (testing on windows passed fine)
  # will be replaced with Test::SubExec::Noninteractive in due course
  require IPC::Open2;
  IPC::Open2::open2(my $out, undef, @cmd);
  while (my $ln = <$out>) {
    print "   $ln";
  }

  wait;
  ok (! $?, "Wstat $? from: @cmd");
}

done_testing;

# clean up our mess
END {
  if (my $dbh = eval { $schema->storage->_dbh }) {
    eval { $dbh->do("DROP TABLE $_") }
      for qw/artist bindtype_test money_test computed_column_test/;
  }

  undef $schema;
}
Commit	Line	Data
a964a928	1	use strict;
68de9438	2	use warnings;
d867eeda	3	no warnings 'uninitialized';
a964a928	4
a964a928	5	use Test::More;
e0b2344f	6	use Test::Exception;
199fbc45	7	use DBIx::Class::Optional::Dependencies ();
a964a928	8	use lib qw(t/lib);
a964a928	9	use DBICTest;
2baff5da	10
6d5679b2	11	my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
	12	if (not ($dsn && $user)) {
	13	plan skip_all => join ' ',
	14	'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test.',
	15	'Warning: This test drops and creates the tables:',
	16	"'artist', 'money_test' and 'bindtype_test'",
	17	;
	18	};
	19
199fbc45	20	plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ase')
	21	unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ase');
	22
d867eeda	23	my @storage_types = (
95787afe	24	'DBI::Sybase::ASE',
95787afe	25	'DBI::Sybase::ASE::NoBindVars',
d867eeda	26	);
5ce107ad	27	eval "require DBIx::Class::Storage::$_;" for @storage_types;
95787afe	28
d867eeda	29	my $schema;
	30	my $storage_idx = -1;
	31
	32	sub get_schema {
	33	DBICTest::Schema->connect($dsn, $user, $pass, {
	34	on_connect_call => [
	35	[ blob_setup => log_on_update => 1 ], # this is a safer option
	36	],
	37	});
	38	}
	39
	40	my $ping_count = 0;
	41	{
95787afe	42	my $ping = DBIx::Class::Storage::DBI::Sybase::ASE->can('_ping');
95787afe	43	*DBIx::Class::Storage::DBI::Sybase::ASE::_ping = sub {
d867eeda	44	$ping_count++;
	45	goto $ping;
	46	};
	47	}
	48
	49	for my $storage_type (@storage_types) {
	50	$storage_idx++;
	51
95787afe	52	unless ($storage_type eq 'DBI::Sybase::ASE') { # autodetect
d867eeda	53	DBICTest::Schema->storage_type("::$storage_type");
d867eeda	54	}
61cfaef7	55
d867eeda	56	$schema = get_schema();
a964a928	57
d867eeda	58	$schema->storage->ensure_connected;
a964a928	59
d867eeda	60	if ($storage_idx == 0 &&
95787afe	61	$schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars')) {
6d5679b2	62	# no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS)
6d5679b2	63	skip "Skipping entire test for $storage_type - no placeholder support", 1;
d867eeda	64	next;
d867eeda	65	}
5703eb14	66
d867eeda	67	isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" );
6b1f5ef7	68
d867eeda	69	$schema->storage->_dbh->disconnect;
d867eeda	70	lives_ok (sub { $schema->storage->dbh }, 'reconnect works');
64f4e691	71
d867eeda	72	$schema->storage->dbh_do (sub {
	73	my ($storage, $dbh) = @_;
	74	eval { $dbh->do("DROP TABLE artist") };
	75	$dbh->do(<<'SQL');
a964a928	76	CREATE TABLE artist (
d867eeda	77	artistid INT IDENTITY PRIMARY KEY,
a964a928	78	name VARCHAR(100),
a964a928	79	rank INT DEFAULT 13 NOT NULL,
d867eeda	80	charfield CHAR(10) NULL
a964a928	81	)
26283ee3	82	SQL
d867eeda	83	});
a964a928	84
d867eeda	85	my %seen_id;
a964a928	86
d867eeda	87	# so we start unconnected
d867eeda	88	$schema->storage->disconnect;
fcc2ec11	89
26283ee3	90	# test primary key handling
d867eeda	91	my $new = $schema->resultset('Artist')->create({ name => 'foo' });
d867eeda	92	ok($new->artistid > 0, "Auto-PK worked");
fcc2ec11	93
d867eeda	94	$seen_id{$new->artistid}++;
fcc2ec11	95
d867eeda	96	# check redispatch to storage-specific insert when auto-detected storage
95787afe	97	if ($storage_type eq 'DBI::Sybase::ASE') {
d867eeda	98	DBICTest::Schema->storage_type('::DBI');
	99	$schema = get_schema();
	100	}
	101
	102	$new = $schema->resultset('Artist')->create({ name => 'Artist 1' });
	103	is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' );
	104	$seen_id{$new->artistid}++;
	105
	106	# inserts happen in a txn, so we make sure it still works inside a txn too
	107	$schema->txn_begin;
	108
	109	for (2..6) {
a964a928	110	$new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
	111	is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
	112	$seen_id{$new->artistid}++;
d867eeda	113	}
a964a928	114
d867eeda	115	$schema->txn_commit;
a964a928	116
d867eeda	117	# test simple count
	118	is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok');
	119
	120	# test LIMIT support
	121	my $it = $schema->resultset('Artist')->search({
	122	artistid => { '>' => 0 }
	123	}, {
a0348159	124	rows => 3,
a0348159	125	order_by => 'artistid',
d867eeda	126	});
af9e4a5e	127
d867eeda	128	is( $it->count, 3, "LIMIT count ok" );
e19677ad	129
d867eeda	130	is( $it->next->name, "foo", "iterator->next ok" );
	131	$it->next;
	132	is( $it->next->name, "Artist 2", "iterator->next ok" );
	133	is( $it->next, undef, "next past end of resultset ok" );
	134
	135	# now try with offset
	136	$it = $schema->resultset('Artist')->search({}, {
	137	rows => 3,
	138	offset => 3,
	139	order_by => 'artistid',
	140	});
	141
	142	is( $it->count, 3, "LIMIT with offset count ok" );
	143
	144	is( $it->next->name, "Artist 3", "iterator->next ok" );
	145	$it->next;
	146	is( $it->next->name, "Artist 5", "iterator->next ok" );
	147	is( $it->next, undef, "next past end of resultset ok" );
	148
	149	# now try a grouped count
	150	$schema->resultset('Artist')->create({ name => 'Artist 6' })
	151	for (1..6);
	152
	153	$it = $schema->resultset('Artist')->search({}, {
	154	group_by => 'name'
	155	});
	156
	157	is( $it->count, 7, 'COUNT of GROUP_BY ok' );
	158
2baff5da	159	# do an IDENTITY_INSERT
d867eeda	160	{
	161	no warnings 'redefine';
	162
	163	my @debug_out;
	164	local $schema->storage->{debug} = 1;
	165	local $schema->storage->debugobj->{callback} = sub {
	166	push @debug_out, $_[1];
	167	};
	168
	169	my $txn_used = 0;
	170	my $txn_commit = \&DBIx::Class::Storage::DBI::txn_commit;
	171	local *DBIx::Class::Storage::DBI::txn_commit = sub {
	172	$txn_used = 1;
	173	goto &$txn_commit;
	174	};
	175
	176	$schema->resultset('Artist')
	177	->create({ artistid => 999, name => 'mtfnpy' });
	178
2baff5da	179	ok((grep /IDENTITY_INSERT/i, @debug_out), 'IDENTITY_INSERT used');
d867eeda	180
	181	SKIP: {
	182	skip 'not testing lack of txn on IDENTITY_INSERT with NoBindVars', 1
	183	if $storage_type =~ /NoBindVars/i;
	184
	185	is $txn_used, 0, 'no txn on insert with IDENTITY_INSERT';
	186	}
	187	}
	188
2baff5da	189	# do an IDENTITY_UPDATE
	190	{
	191	my @debug_out;
	192	local $schema->storage->{debug} = 1;
	193	local $schema->storage->debugobj->{callback} = sub {
	194	push @debug_out, $_[1];
	195	};
	196
	197	lives_and {
	198	$schema->resultset('Artist')
	199	->find(999)->update({ artistid => 555 });
	200	ok((grep /IDENTITY_UPDATE/i, @debug_out));
	201	} 'IDENTITY_UPDATE used';
	202	$ping_count-- if $@;
	203	}
d867eeda	204
	205	my $bulk_rs = $schema->resultset('Artist')->search({
	206	name => { -like => 'bulk artist %' }
	207	});
	208
0a9a9955	209	# test insert_bulk using populate.
2baff5da	210	SKIP: {
2baff5da	211	skip 'insert_bulk not supported', 4
d390bd3c	212	unless $storage_type !~ /NoBindVars/i;
e06ad5d5	213
2baff5da	214	lives_ok {
	215	$schema->resultset('Artist')->populate([
	216	{
	217	name => 'bulk artist 1',
	218	charfield => 'foo',
	219	},
	220	{
	221	name => 'bulk artist 2',
	222	charfield => 'foo',
	223	},
	224	{
	225	name => 'bulk artist 3',
	226	charfield => 'foo',
	227	},
	228	]);
	229	} 'insert_bulk via populate';
	230
	231	is $bulk_rs->count, 3, 'correct number inserted via insert_bulk';
	232
	233	is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
	234	'column set correctly via insert_bulk');
	235
	236	my %bulk_ids;
	237	@bulk_ids{map $_->artistid, $bulk_rs->all} = ();
	238
	239	is ((scalar keys %bulk_ids), 3,
	240	'identities generated correctly in insert_bulk');
	241
	242	$bulk_rs->delete;
	243	}
e06ad5d5	244
0a9a9955	245	# make sure insert_bulk works a second time on the same connection
	246	SKIP: {
	247	skip 'insert_bulk not supported', 3
d390bd3c	248	unless $storage_type !~ /NoBindVars/i;
0a9a9955	249
	250	lives_ok {
	251	$schema->resultset('Artist')->populate([
	252	{
	253	name => 'bulk artist 1',
	254	charfield => 'bar',
	255	},
	256	{
	257	name => 'bulk artist 2',
	258	charfield => 'bar',
	259	},
	260	{
	261	name => 'bulk artist 3',
	262	charfield => 'bar',
	263	},
	264	]);
	265	} 'insert_bulk via populate called a second time';
	266
	267	is $bulk_rs->count, 3,
	268	'correct number inserted via insert_bulk';
	269
	270	is ((grep $_->charfield eq 'bar', $bulk_rs->all), 3,
	271	'column set correctly via insert_bulk');
	272
	273	$bulk_rs->delete;
	274	}
	275
	276	# test invalid insert_bulk (missing required column)
	277	#
	278	# There should be a rollback, reconnect and the next valid insert_bulk should
	279	# succeed.
	280	throws_ok {
	281	$schema->resultset('Artist')->populate([
	282	{
	283	charfield => 'foo',
	284	}
	285	]);
	286	} qr/no value or default\|does not allow null\|placeholders/i,
	287	# The second pattern is the error from fallback to regular array insert on
	288	# incompatible charset.
	289	# The third is for ::NoBindVars with no syb_has_blk.
	290	'insert_bulk with missing required column throws error';
	291
d867eeda	292	# now test insert_bulk with IDENTITY_INSERT
2baff5da	293	SKIP: {
2baff5da	294	skip 'insert_bulk not supported', 3
d390bd3c	295	unless $storage_type !~ /NoBindVars/i;
e19677ad	296
2baff5da	297	lives_ok {
	298	$schema->resultset('Artist')->populate([
	299	{
	300	artistid => 2001,
	301	name => 'bulk artist 1',
	302	charfield => 'foo',
	303	},
	304	{
	305	artistid => 2002,
	306	name => 'bulk artist 2',
	307	charfield => 'foo',
	308	},
	309	{
	310	artistid => 2003,
	311	name => 'bulk artist 3',
	312	charfield => 'foo',
	313	},
	314	]);
	315	} 'insert_bulk with IDENTITY_INSERT via populate';
	316
	317	is $bulk_rs->count, 3,
	318	'correct number inserted via insert_bulk with IDENTITY_INSERT';
	319
	320	is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
	321	'column set correctly via insert_bulk with IDENTITY_INSERT');
	322
	323	$bulk_rs->delete;
	324	}
d867eeda	325
	326	# test correlated subquery
	327	my $subq = $schema->resultset('Artist')->search({ artistid => { '>' => 3 } })
	328	->get_column('artistid')
	329	->as_query;
	330	my $subq_rs = $schema->resultset('Artist')->search({
	331	artistid => { -in => $subq }
	332	});
	333	is $subq_rs->count, 11, 'correlated subquery';
	334
	335	# mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
	336	SKIP: {
587daa97	337	skip 'TEXT/IMAGE support does not work with FreeTDS', 22
aca3b4c3	338	if $schema->storage->_using_freetds;
d867eeda	339
	340	my $dbh = $schema->storage->_dbh;
	341	{
	342	local $SIG{__WARN__} = sub {};
	343	eval { $dbh->do('DROP TABLE bindtype_test') };
	344
	345	$dbh->do(qq[
8273e845	346	CREATE TABLE bindtype_test
d867eeda	347	(
f3a9ea3d	348	id INT IDENTITY PRIMARY KEY,
	349	bytea IMAGE NULL,
	350	blob IMAGE NULL,
	351	clob TEXT NULL,
	352	a_memo IMAGE NULL
d867eeda	353	)
	354	],{ RaiseError => 1, PrintError => 0 });
	355	}
	356
	357	my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
	358	$binstr{'large'} = $binstr{'small'} x 1024;
	359
	360	my $maxloblen = length $binstr{'large'};
8273e845	361
aca3b4c3	362	if (not $schema->storage->_using_freetds) {
d867eeda	363	$dbh->{'LongReadLen'} = $maxloblen * 2;
	364	} else {
	365	$dbh->do("set textsize ".($maxloblen * 2));
	366	}
	367
	368	my $rs = $schema->resultset('BindType');
	369	my $last_id;
	370
	371	foreach my $type (qw(blob clob)) {
	372	foreach my $size (qw(small large)) {
	373	no warnings 'uninitialized';
	374
0a9a9955	375	my $created;
	376	lives_ok {
	377	$created = $rs->create( { $type => $binstr{$size} } )
	378	} "inserted $size $type without dying";
d867eeda	379
	380	$last_id = $created->id if $created;
	381
0a9a9955	382	lives_and {
	383	ok($rs->find($last_id)->$type eq $binstr{$size})
	384	} "verified inserted $size $type";
d867eeda	385	}
	386	}
	387
689819e1	388	$rs->delete;
689819e1	389
0a9a9955	390	# blob insert with explicit PK
	391	# also a good opportunity to test IDENTITY_INSERT
	392	lives_ok {
	393	$rs->create( { id => 1, blob => $binstr{large} } )
	394	} 'inserted large blob without dying with manual PK';
d867eeda	395
0a9a9955	396	lives_and {
	397	ok($rs->find(1)->blob eq $binstr{large})
	398	} 'verified inserted large blob with manual PK';
d867eeda	399
	400	# try a blob update
	401	my $new_str = $binstr{large} . 'mtfnpy';
	402
	403	# check redispatch to storage-specific update when auto-detected storage
95787afe	404	if ($storage_type eq 'DBI::Sybase::ASE') {
d867eeda	405	DBICTest::Schema->storage_type('::DBI');
	406	$schema = get_schema();
	407	}
	408
0a9a9955	409	lives_ok {
	410	$rs->search({ id => 1 })->update({ blob => $new_str })
	411	} 'updated blob successfully';
	412
	413	lives_and {
	414	ok($rs->find(1)->blob eq $new_str)
	415	} 'verified updated blob';
d867eeda	416
2baff5da	417	# try a blob update with IDENTITY_UPDATE
	418	lives_and {
	419	$new_str = $binstr{large} . 'hlagh';
	420	$rs->find(1)->update({ id => 999, blob => $new_str });
	421	ok($rs->find(999)->blob eq $new_str);
	422	} 'verified updated blob with IDENTITY_UPDATE';
7ef97d26	423
d867eeda	424	## try multi-row blob update
d867eeda	425	# first insert some blobs
d867eeda	426	$new_str = $binstr{large} . 'foo';
0a9a9955	427	lives_and {
	428	$rs->delete;
	429	$rs->create({ blob => $binstr{large} }) for (1..2);
	430	$rs->update({ blob => $new_str });
	431	is((grep $_->blob eq $new_str, $rs->all), 2);
	432	} 'multi-row blob update';
	433
	434	$rs->delete;
	435
587daa97	436	# now try insert_bulk with blobs and only blobs
0a9a9955	437	$new_str = $binstr{large} . 'bar';
	438	lives_ok {
	439	$rs->populate([
	440	{
0a9a9955	441	blob => $binstr{large},
	442	clob => $new_str,
	443	},
	444	{
0a9a9955	445	blob => $binstr{large},
	446	clob => $new_str,
	447	},
	448	]);
	449	} 'insert_bulk with blobs does not die';
	450
	451	is((grep $_->blob eq $binstr{large}, $rs->all), 2,
	452	'IMAGE column set correctly via insert_bulk');
	453
	454	is((grep $_->clob eq $new_str, $rs->all), 2,
	455	'TEXT column set correctly via insert_bulk');
2baff5da	456
587daa97	457	# now try insert_bulk with blobs and a non-blob which also happens to be an
	458	# identity column
	459	SKIP: {
	460	skip 'no insert_bulk without placeholders', 4
	461	if $storage_type =~ /NoBindVars/i;
	462
	463	$rs->delete;
	464	$new_str = $binstr{large} . 'bar';
	465	lives_ok {
	466	$rs->populate([
	467	{
	468	id => 1,
	469	bytea => 1,
	470	blob => $binstr{large},
	471	clob => $new_str,
f3a9ea3d	472	a_memo => 2,
587daa97	473	},
	474	{
	475	id => 2,
	476	bytea => 1,
	477	blob => $binstr{large},
	478	clob => $new_str,
f3a9ea3d	479	a_memo => 2,
587daa97	480	},
587daa97	481	]);
db66bc3f	482	} 'insert_bulk with blobs and explicit identity does NOT die';
587daa97	483
	484	is((grep $_->blob eq $binstr{large}, $rs->all), 2,
	485	'IMAGE column set correctly via insert_bulk with identity');
	486
	487	is((grep $_->clob eq $new_str, $rs->all), 2,
	488	'TEXT column set correctly via insert_bulk with identity');
	489
	490	is_deeply [ map $_->id, $rs->all ], [ 1,2 ],
	491	'explicit identities set correctly via insert_bulk with blobs';
	492	}
	493
d390bd3c	494	lives_and {
	495	$rs->delete;
	496	$rs->create({ blob => $binstr{large} }) for (1..2);
	497	$rs->update({ blob => undef });
	498	is((grep !defined($_->blob), $rs->all), 2);
	499	} 'blob update to NULL';
d867eeda	500	}
d867eeda	501
cd048330	502	# test MONEY column support (and some other misc. stuff)
d867eeda	503	$schema->storage->dbh_do (sub {
	504	my ($storage, $dbh) = @_;
	505	eval { $dbh->do("DROP TABLE money_test") };
	506	$dbh->do(<<'SQL');
	507	CREATE TABLE money_test (
	508	id INT IDENTITY PRIMARY KEY,
cd048330	509	amount MONEY DEFAULT $999.99 NULL
d867eeda	510	)
	511	SQL
	512	});
	513
cd048330	514	my $rs = $schema->resultset('Money');
	515
	516	# test insert with defaults
	517	lives_and {
	518	$rs->create({});
	519	is((grep $_->amount == 999.99, $rs->all), 1);
	520	} 'insert with all defaults works';
	521	$rs->delete;
	522
d867eeda	523	# test insert transaction when there's an active cursor
2baff5da	524	{
d867eeda	525	my $artist_rs = $schema->resultset('Artist');
	526	$artist_rs->first;
	527	lives_ok {
	528	my $row = $schema->resultset('Money')->create({ amount => 100 });
	529	$row->delete;
	530	} 'inserted a row with an active cursor';
	531	$ping_count-- if $@; # dbh_do calls ->connected
	532	}
	533
	534	# test insert in an outer transaction when there's an active cursor
	535	TODO: {
	536	local $TODO = 'this should work once we have eager cursors';
	537
	538	# clear state, or we get a deadlock on $row->delete
	539	# XXX figure out why this happens
	540	$schema->storage->disconnect;
	541
	542	lives_ok {
	543	$schema->txn_do(sub {
	544	my $artist_rs = $schema->resultset('Artist');
	545	$artist_rs->first;
	546	my $row = $schema->resultset('Money')->create({ amount => 100 });
	547	$row->delete;
	548	});
	549	} 'inserted a row with an active cursor in outer txn';
	550	$ping_count-- if $@; # dbh_do calls ->connected
	551	}
	552
	553	# Now test money values.
d867eeda	554	my $row;
	555	lives_ok {
	556	$row = $rs->create({ amount => 100 });
	557	} 'inserted a money value';
	558
cdf7f026	559	cmp_ok eval { $rs->find($row->id)->amount }, '==', 100,
cdf7f026	560	'money value round-trip';
d867eeda	561
	562	lives_ok {
	563	$row->update({ amount => 200 });
	564	} 'updated a money value';
	565
cdf7f026	566	cmp_ok eval { $rs->find($row->id)->amount }, '==', 200,
cdf7f026	567	'updated money value round-trip';
d867eeda	568
	569	lives_ok {
	570	$row->update({ amount => undef });
	571	} 'updated a money value to NULL';
	572
46891041	573	lives_and {
ca507a2f	574	my $null_amount = $rs->find($row->id)->amount;
46891041	575	is $null_amount, undef;
46891041	576	} 'updated money value to NULL round-trip';
6469dabf	577
	578	# Test computed columns and timestamps
	579	$schema->storage->dbh_do (sub {
	580	my ($storage, $dbh) = @_;
	581	eval { $dbh->do("DROP TABLE computed_column_test") };
	582	$dbh->do(<<'SQL');
	583	CREATE TABLE computed_column_test (
	584	id INT IDENTITY PRIMARY KEY,
	585	a_computed_column AS getdate(),
	586	a_timestamp timestamp,
8273e845	587	charfield VARCHAR(20) DEFAULT 'foo'
6469dabf	588	)
	589	SQL
	590	});
	591
	592	require DBICTest::Schema::ComputedColumn;
	593	$schema->register_class(
	594	ComputedColumn => 'DBICTest::Schema::ComputedColumn'
	595	);
	596
	597	ok (($rs = $schema->resultset('ComputedColumn')),
	598	'got rs for ComputedColumn');
	599
	600	lives_ok { $row = $rs->create({}) }
	601	'empty insert for a table with computed columns survived';
	602
	603	lives_ok {
	604	$row->update({ charfield => 'bar' })
	605	} 'update of a table with computed columns survived';
d867eeda	606	}
	607
	608	is $ping_count, 0, 'no pings';
f1358489	609
72933b15	610	# if tests passed and did so under a non-C lang - let's rerun the test
	611	if (Test::Builder->new->is_passing and $ENV{LANG} and $ENV{LANG} ne 'C') {
	612	my $oldlang = $ENV{LANG};
	613	local $ENV{LANG} = 'C';
	614
	615	pass ("Your lang is set to $oldlang - retesting with C");
	616
	617	my @cmd = ($^X, __FILE__);
	618
	619	# this is cheating, and may even hang here and there (testing on windows passed fine)
	620	# will be replaced with Test::SubExec::Noninteractive in due course
	621	require IPC::Open2;
	622	IPC::Open2::open2(my $out, undef, @cmd);
	623	while (my $ln = <$out>) {
	624	print " $ln";
	625	}
	626
	627	wait;
	628	ok (! $?, "Wstat $? from: @cmd");
	629	}
	630
6d5679b2	631	done_testing;
6d5679b2	632
a964a928	633	# clean up our mess
a964a928	634	END {
d867eeda	635	if (my $dbh = eval { $schema->storage->_dbh }) {
d867eeda	636	eval { $dbh->do("DROP TABLE $_") }
6469dabf	637	for qw/artist bindtype_test money_test computed_column_test/;
d867eeda	638	}
65d35121	639
65d35121	640	undef $schema;
a964a928	641	}