t/749sqlanywhere.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Exception;
   6 use Scope::Guard ();
   7 use Try::Tiny;
   8 use DBIx::Class::Optional::Dependencies ();
   9 use lib qw(t/lib);
  10 use DBICTest;
  11
  12 my ($dsn, $user, $pass)    = @ENV{map { "DBICTEST_SQLANYWHERE_${_}" }      qw/DSN USER PASS/};
  13 my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SQLANYWHERE_ODBC_${_}" } qw/DSN USER PASS/};
  14
  15 plan skip_all => 'Test needs ' .
  16   (join ' or ', map { $_ ? $_ : () }
  17     DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere'),
  18     DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere_odbc'))
  19   unless
  20     $dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere')
  21     or
  22     $dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere_odbc')
  23     or
  24     (not $dsn || $dsn2);
  25
  26 DBICTest::Schema->load_classes('ArtistGUID');
  27
  28 # tests stolen from 748informix.t
  29
  30 plan skip_all => <<'EOF' unless $dsn || $dsn2;
  31 Set $ENV{DBICTEST_SQLANYWHERE_DSN} and/or $ENV{DBICTEST_SQLANYWHERE_ODBC_DSN},
  32 _USER and _PASS to run these tests
  33 EOF
  34
  35 my @info = (
  36   [ $dsn,  $user,  $pass  ],
  37   [ $dsn2, $user2, $pass2 ],
  38 );
  39
  40 my $schema;
  41
  42 foreach my $info (@info) {
  43   my ($dsn, $user, $pass) = @$info;
  44
  45   next unless $dsn;
  46
  47   $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
  48     auto_savepoint => 1
  49   });
  50
  51   my $guard = Scope::Guard->new(sub{ cleanup($schema) });
  52
  53   my $dbh = $schema->storage->dbh;
  54
  55   eval { $dbh->do("DROP TABLE artist") };
  56
  57   $dbh->do(<<EOF);
  58   CREATE TABLE artist (
  59     artistid INT IDENTITY PRIMARY KEY,
  60     name VARCHAR(255) NULL,
  61     charfield CHAR(10) NULL,
  62     rank INT DEFAULT 13
  63   )
  64 EOF
  65
  66   my $ars = $schema->resultset('Artist');
  67   is ( $ars->count, 0, 'No rows at first' );
  68
  69 # test primary key handling
  70   my $new = $ars->create({ name => 'foo' });
  71   ok($new->artistid, "Auto-PK worked");
  72
  73 # test explicit key spec
  74   $new = $ars->create ({ name => 'bar', artistid => 66 });
  75   is($new->artistid, 66, 'Explicit PK worked');
  76   $new->discard_changes;
  77   is($new->artistid, 66, 'Explicit PK assigned');
  78
  79 # test savepoints
  80   throws_ok {
  81     $schema->txn_do(sub {
  82       eval {
  83         $schema->txn_do(sub {
  84           $ars->create({ name => 'in_savepoint' });
  85           die "rolling back savepoint";
  86         });
  87       };
  88       ok ((not $ars->search({ name => 'in_savepoint' })->first),
  89         'savepoint rolled back');
  90       $ars->create({ name => 'in_outer_txn' });
  91       die "rolling back outer txn";
  92     });
  93   } qr/rolling back outer txn/,
  94     'correct exception for rollback';
  95
  96   ok ((not $ars->search({ name => 'in_outer_txn' })->first),
  97     'outer txn rolled back');
  98
  99 # test populate
 100   lives_ok (sub {
 101     my @pop;
 102     for (1..2) {
 103       push @pop, { name => "Artist_$_" };
 104     }
 105     $ars->populate (\@pop);
 106   });
 107
 108 # test populate with explicit key
 109   lives_ok (sub {
 110     my @pop;
 111     for (1..2) {
 112       push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
 113     }
 114     $ars->populate (\@pop);
 115   });
 116
 117 # count what we did so far
 118   is ($ars->count, 6, 'Simple count works');
 119
 120 # test LIMIT support
 121   my $lim = $ars->search( {},
 122     {
 123       rows => 3,
 124       offset => 4,
 125       order_by => 'artistid'
 126     }
 127   );
 128   is( $lim->count, 2, 'ROWS+OFFSET count ok' );
 129   is( $lim->all, 2, 'Number of ->all objects matches count' );
 130
 131 # test iterator
 132   $lim->reset;
 133   is( $lim->next->artistid, 101, "iterator->next ok" );
 134   is( $lim->next->artistid, 102, "iterator->next ok" );
 135   is( $lim->next, undef, "next past end of resultset ok" );
 136
 137 # test empty insert
 138   {
 139     local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0;
 140
 141     lives_ok { $ars->create({}) }
 142       'empty insert works';
 143   }
 144
 145 # test blobs (stolen from 73oracle.t)
 146   eval { $dbh->do('DROP TABLE bindtype_test') };
 147   $dbh->do(qq[
 148   CREATE TABLE bindtype_test
 149   (
 150     id     INT          NOT NULL PRIMARY KEY,
 151     bytea  INT          NULL,
 152     blob   LONG BINARY  NULL,
 153     blob2  LONG BINARY  NULL,
 154     clob   LONG VARCHAR NULL,
 155     clob2  LONG VARCHAR NULL,
 156     a_memo INT          NULL
 157   )
 158   ],{ RaiseError => 1, PrintError => 1 });
 159
 160   my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
 161   $binstr{'large'} = $binstr{'small'} x 1024;
 162
 163   my $maxloblen = length $binstr{'large'};
 164   local $dbh->{'LongReadLen'} = $maxloblen;
 165
 166   my $rs = $schema->resultset('BindType');
 167   my $id = 0;
 168
 169   foreach my $type (qw( blob clob )) {
 170     foreach my $size (qw( small large )) {
 171       $id++;
 172
 173 # turn off horrendous binary DBIC_TRACE output
 174       local $schema->storage->{debug} = 0;
 175
 176       lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
 177       "inserted $size $type without dying";
 178
 179       ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
 180     }
 181   }
 182
 183   my @uuid_types = qw/uniqueidentifier uniqueidentifierstr/;
 184
 185 # test uniqueidentifiers (and the cursor_class).
 186
 187   for my $uuid_type (@uuid_types) {
 188     local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
 189       = $uuid_type;
 190
 191     local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
 192       = $uuid_type;
 193
 194     $schema->storage->dbh_do (sub {
 195       my ($storage, $dbh) = @_;
 196       eval { $dbh->do("DROP TABLE artist_guid") };
 197       $dbh->do(<<"SQL");
 198 CREATE TABLE artist_guid (
 199    artistid $uuid_type NOT NULL,
 200    name VARCHAR(100),
 201    rank INT NOT NULL DEFAULT '13',
 202    charfield CHAR(10) NULL,
 203    a_guid $uuid_type,
 204    primary key(artistid)
 205 )
 206 SQL
 207     });
 208
 209     local $TODO = 'something wrong with uniqueidentifierstr over ODBC'
 210       if $dsn =~ /:ODBC:/ && $uuid_type eq 'uniqueidentifierstr';
 211
 212     my $row;
 213     lives_ok {
 214       $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
 215     } 'created a row with a GUID';
 216
 217     ok(
 218       eval { $row->artistid },
 219       'row has GUID PK col populated',
 220     );
 221     diag $@ if $@;
 222
 223     ok(
 224       eval { $row->a_guid },
 225       'row has a GUID col with auto_nextval populated',
 226     );
 227     diag $@ if $@;
 228
 229     my $row_from_db = try { $schema->resultset('ArtistGUID')
 230       ->search({ name => 'mtfnpy' })->first }
 231       catch { diag $_ };
 232
 233     is try { $row_from_db->artistid }, $row->artistid,
 234       'PK GUID round trip (via ->search->next)';
 235
 236     is try { $row_from_db->a_guid }, $row->a_guid,
 237       'NON-PK GUID round trip (via ->search->next)';
 238
 239     $row_from_db = try { $schema->resultset('ArtistGUID')
 240       ->find($row->artistid) }
 241       catch { diag $_ };
 242
 243     is try { $row_from_db->artistid }, $row->artistid,
 244       'PK GUID round trip (via ->find)';
 245
 246     is try { $row_from_db->a_guid }, $row->a_guid,
 247       'NON-PK GUID round trip (via ->find)';
 248
 249     ($row_from_db) = try { $schema->resultset('ArtistGUID')
 250       ->search({ name => 'mtfnpy' })->all }
 251       catch { diag $_ };
 252
 253     is try { $row_from_db->artistid }, $row->artistid,
 254       'PK GUID round trip (via ->search->all)';
 255
 256     is try { $row_from_db->a_guid }, $row->a_guid,
 257       'NON-PK GUID round trip (via ->search->all)';
 258   }
 259 }
 260
 261 done_testing;
 262
 263 sub cleanup {
 264   my $schema = shift;
 265   eval { $schema->storage->dbh->do("DROP TABLE $_") }
 266     for qw/artist artist_guid bindtype_test/;
 267 }