t/749sqlanywhere.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use DBIx::Class::Optional::Dependencies ();
   9 use DBIx::Class::_Util 'scope_guard';
  10
  11 use DBICTest;
  12
  13 my ($dsn, $user, $pass)    = @ENV{map { "DBICTEST_SQLANYWHERE_${_}" }      qw/DSN USER PASS/};
  14 my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SQLANYWHERE_ODBC_${_}" } qw/DSN USER PASS/};
  15
  16 plan skip_all => 'Test needs ' .
  17   (join ' or ', map { $_ ? $_ : () }
  18     DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere'),
  19     DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere_odbc'))
  20   unless
  21     $dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere')
  22     or
  23     $dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere_odbc')
  24     or
  25     (not $dsn || $dsn2);
  26
  27 DBICTest::Schema->load_classes('ArtistGUID');
  28
  29 # tests stolen from 748informix.t
  30
  31 plan skip_all => <<'EOF' unless $dsn || $dsn2;
  32 Set $ENV{DBICTEST_SQLANYWHERE_DSN} and/or $ENV{DBICTEST_SQLANYWHERE_ODBC_DSN},
  33 _USER and _PASS to run these tests
  34 EOF
  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 { 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;
 229     lives_ok {
 230       $row_from_db = $schema->resultset('ArtistGUID')->search({ name => 'mtfnpy' })->first
 231     };
 232
 233     is(
 234       eval { $row_from_db->artistid },
 235       $row->artistid,
 236       'PK GUID round trip (via ->search->next)'
 237     );
 238
 239     is(
 240       eval { $row_from_db->a_guid },
 241       $row->a_guid,
 242       'NON-PK GUID round trip (via ->search->next)'
 243     );
 244
 245     lives_ok {
 246       $row_from_db = $schema->resultset('ArtistGUID')->find($row->artistid)
 247     };
 248
 249     is(
 250       eval { $row_from_db->artistid },
 251       $row->artistid,
 252       'PK GUID round trip (via ->find)'
 253     );
 254
 255     is(
 256       eval { $row_from_db->a_guid },
 257       $row->a_guid,
 258       'NON-PK GUID round trip (via ->find)'
 259     );
 260
 261     lives_ok {
 262       ($row_from_db) = $schema->resultset('ArtistGUID')->search({ name => 'mtfnpy' })->all
 263     };
 264
 265     is(
 266       eval { $row_from_db->artistid },
 267       $row->artistid,
 268       'PK GUID round trip (via ->search->all)'
 269     );
 270
 271     is(
 272       eval { $row_from_db->a_guid },
 273       $row->a_guid,
 274       'NON-PK GUID round trip (via ->search->all)'
 275     );
 276   }
 277 }
 278
 279 done_testing;
 280
 281 sub cleanup {
 282   my $schema = shift;
 283   eval { $schema->storage->dbh->do("DROP TABLE $_") }
 284     for qw/artist artist_guid bindtype_test/;
 285 }