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     clob   LONG VARCHAR NULL,
 155     a_memo INT          NULL
 156   )
 157   ],{ RaiseError => 1, PrintError => 1 });
 158
 159   my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
 160   $binstr{'large'} = $binstr{'small'} x 1024;
 161
 162   my $maxloblen = length $binstr{'large'};
 163   local $dbh->{'LongReadLen'} = $maxloblen;
 164
 165   my $rs = $schema->resultset('BindType');
 166   my $id = 0;
 167
 168   foreach my $type (qw( blob clob )) {
 169     foreach my $size (qw( small large )) {
 170       $id++;
 171
 172 # turn off horrendous binary DBIC_TRACE output
 173       local $schema->storage->{debug} = 0;
 174
 175       lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
 176       "inserted $size $type without dying";
 177
 178       ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
 179     }
 180   }
 181
 182   my @uuid_types = qw/uniqueidentifier uniqueidentifierstr/;
 183
 184 # test uniqueidentifiers (and the cursor_class).
 185
 186   for my $uuid_type (@uuid_types) {
 187     local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
 188       = $uuid_type;
 189
 190     local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
 191       = $uuid_type;
 192
 193     $schema->storage->dbh_do (sub {
 194       my ($storage, $dbh) = @_;
 195       eval { $dbh->do("DROP TABLE artist_guid") };
 196       $dbh->do(<<"SQL");
 197 CREATE TABLE artist_guid (
 198    artistid $uuid_type NOT NULL,
 199    name VARCHAR(100),
 200    rank INT NOT NULL DEFAULT '13',
 201    charfield CHAR(10) NULL,
 202    a_guid $uuid_type,
 203    primary key(artistid)
 204 )
 205 SQL
 206     });
 207
 208     local $TODO = 'something wrong with uniqueidentifierstr over ODBC'
 209       if $dsn =~ /:ODBC:/ && $uuid_type eq 'uniqueidentifierstr';
 210
 211     my $row;
 212     lives_ok {
 213       $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
 214     } 'created a row with a GUID';
 215
 216     ok(
 217       eval { $row->artistid },
 218       'row has GUID PK col populated',
 219     );
 220     diag $@ if $@;
 221
 222     ok(
 223       eval { $row->a_guid },
 224       'row has a GUID col with auto_nextval populated',
 225     );
 226     diag $@ if $@;
 227
 228     my $row_from_db = try { $schema->resultset('ArtistGUID')
 229       ->search({ name => 'mtfnpy' })->first }
 230       catch { diag $_ };
 231
 232     is try { $row_from_db->artistid }, $row->artistid,
 233       'PK GUID round trip (via ->search->next)';
 234
 235     is try { $row_from_db->a_guid }, $row->a_guid,
 236       'NON-PK GUID round trip (via ->search->next)';
 237
 238     $row_from_db = try { $schema->resultset('ArtistGUID')
 239       ->find($row->artistid) }
 240       catch { diag $_ };
 241
 242     is try { $row_from_db->artistid }, $row->artistid,
 243       'PK GUID round trip (via ->find)';
 244
 245     is try { $row_from_db->a_guid }, $row->a_guid,
 246       'NON-PK GUID round trip (via ->find)';
 247
 248     ($row_from_db) = try { $schema->resultset('ArtistGUID')
 249       ->search({ name => 'mtfnpy' })->all }
 250       catch { diag $_ };
 251
 252     is try { $row_from_db->artistid }, $row->artistid,
 253       'PK GUID round trip (via ->search->all)';
 254
 255     is try { $row_from_db->a_guid }, $row->a_guid,
 256       'NON-PK GUID round trip (via ->search->all)';
 257   }
 258 }
 259
 260 done_testing;
 261
 262 sub cleanup {
 263   my $schema = shift;
 264   eval { $schema->storage->dbh->do("DROP TABLE $_") }
 265     for qw/artist artist_guid bindtype_test/;
 266 }