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