t/751msaccess.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 lib qw(t/lib);
   9 use DBICTest;
  10
  11 DBICTest::Schema->load_classes('ArtistGUID');
  12
  13 # Example DSNs (32bit only):
  14 # dbi:ODBC:driver={Microsoft Access Driver (*.mdb, *.accdb)};dbq=C:\Users\rkitover\Documents\access_sample.accdb
  15 # dbi:ADO:Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb
  16 # dbi:ADO:Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb;Persist Security Info=False'
  17
  18 my ($dsn,  $user,  $pass)  = @ENV{map { "DBICTEST_MSACCESS_ODBC_${_}" } qw/DSN USER PASS/};
  19 my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSACCESS_ADO_${_}" }  qw/DSN USER PASS/};
  20
  21 plan skip_all => <<'EOF' unless $dsn || $dsn2;
  22 Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.
  23 Warning: this test drops and creates the tables 'artist', 'cd', 'bindtype_test' and 'artist_guid'.
  24 EOF
  25
  26 plan skip_all => 'Test needs ' .
  27 DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_odbc')
  28 . ' or ' .
  29 DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado')
  30   unless
  31     DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
  32     or
  33     DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado');
  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 # Check that we can connect without any options.
  48   $schema = DBICTest::Schema->connect($dsn, $user, $pass);
  49   lives_ok {
  50     $schema->storage->ensure_connected;
  51   } 'connection without any options';
  52
  53   my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
  54   $binstr{'large'} = $binstr{'small'} x 1024;
  55
  56   my $maxloblen = length $binstr{'large'};
  57
  58   $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
  59     quote_names => 1,
  60     auto_savepoint => 1,
  61     LongReadLen => $maxloblen,
  62   });
  63
  64   my $guard = Scope::Guard->new(\&cleanup);
  65
  66   my $dbh = $schema->storage->dbh;
  67
  68   # turn off warnings for OLE exception from ADO about nonexistant table
  69   eval { local $^W = 0; $dbh->do("DROP TABLE artist") };
  70
  71   $dbh->do(<<EOF);
  72   CREATE TABLE artist (
  73     artistid AUTOINCREMENT PRIMARY KEY,
  74     name VARCHAR(255) NULL,
  75     charfield CHAR(10) NULL,
  76     rank INT NULL
  77   )
  78 EOF
  79
  80   my $ars = $schema->resultset('Artist');
  81   is ( $ars->count, 0, 'No rows at first' );
  82
  83 # test primary key handling
  84   my $new = $ars->create({ name => 'foo' });
  85   ok($new->artistid, "Auto-PK worked");
  86
  87   my $first_artistid = $new->artistid;
  88
  89 # test explicit key spec
  90   $new = $ars->create ({ name => 'bar', artistid => 66 });
  91   is($new->artistid, 66, 'Explicit PK worked');
  92   $new->discard_changes;
  93   is($new->artistid, 66, 'Explicit PK assigned');
  94
  95 # test joins
  96   eval { local $^W = 0; $dbh->do("DROP TABLE cd") };
  97
  98   $dbh->do(<<EOF);
  99   CREATE TABLE cd (
 100     cdid AUTOINCREMENT PRIMARY KEY,
 101     artist INTEGER NULL,
 102     title VARCHAR(255) NULL,
 103     [year] CHAR(4) NULL,
 104     genreid INTEGER NULL,
 105     single_track INTEGER NULL
 106   )
 107 EOF
 108
 109   $dbh->do(<<EOF);
 110   CREATE TABLE track (
 111     trackid AUTOINCREMENT PRIMARY KEY,
 112     cd INTEGER REFERENCES cd(cdid),
 113     [position] INTEGER,
 114     title VARCHAR(255),
 115     last_updated_on DATETIME,
 116     last_updated_at DATETIME
 117   )
 118 EOF
 119
 120   my $cd = $schema->resultset('CD')->create({
 121     artist => $first_artistid,
 122     title => 'Some Album',
 123   });
 124
 125 # one-step join
 126   my $joined_artist = $schema->resultset('Artist')->search({
 127     artistid => $first_artistid,
 128   }, {
 129     join => [ 'cds' ],
 130     '+select' => [ 'cds.title' ],
 131     '+as'     => [ 'cd_title'  ],
 132   })->next;
 133
 134   is $joined_artist->get_column('cd_title'), 'Some Album',
 135     'one-step join works';
 136
 137 # two-step join
 138   my $track = $schema->resultset('Track')->create({
 139     cd => $cd->cdid,
 140     position => 1,
 141     title => 'my track',
 142   });
 143
 144   my $joined_track = try {
 145     $schema->resultset('Artist')->search({
 146       artistid => $first_artistid,
 147     }, {
 148       join => [{ cds => 'tracks' }],
 149       '+select' => [ 'tracks.title' ],
 150       '+as'     => [ 'track_title'  ],
 151     })->next;
 152   }
 153   catch {
 154     diag "Could not execute two-step join: $_";
 155   };
 156
 157   is try { $joined_track->get_column('track_title') }, 'my track',
 158     'two-step join works';
 159
 160 # test basic transactions
 161   $schema->txn_do(sub {
 162     $ars->create({ name => 'transaction_commit' });
 163   });
 164   ok($ars->search({ name => 'transaction_commit' })->first,
 165     'transaction committed');
 166   $ars->search({ name => 'transaction_commit' })->delete,
 167   throws_ok {
 168     $schema->txn_do(sub {
 169       $ars->create({ name => 'transaction_rollback' });
 170       die 'rolling back';
 171     });
 172   } qr/rolling back/, 'rollback executed';
 173   is $ars->search({ name => 'transaction_rollback' })->first, undef,
 174     'transaction rolled back';
 175
 176 # test two-phase commit and inner transaction rollback from nested transactions
 177   $schema->txn_do(sub {
 178     $ars->create({ name => 'in_outer_transaction' });
 179     $schema->txn_do(sub {
 180       $ars->create({ name => 'in_inner_transaction' });
 181     });
 182     ok($ars->search({ name => 'in_inner_transaction' })->first,
 183       'commit from inner transaction visible in outer transaction');
 184     throws_ok {
 185       $schema->txn_do(sub {
 186         $ars->create({ name => 'in_inner_transaction_rolling_back' });
 187         die 'rolling back inner transaction';
 188       });
 189     } qr/rolling back inner transaction/, 'inner transaction rollback executed';
 190   });
 191   ok($ars->search({ name => 'in_outer_transaction' })->first,
 192     'commit from outer transaction');
 193   ok($ars->search({ name => 'in_inner_transaction' })->first,
 194     'commit from inner transaction');
 195   is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
 196     undef,
 197     'rollback from inner transaction';
 198   $ars->search({ name => 'in_outer_transaction' })->delete;
 199   $ars->search({ name => 'in_inner_transaction' })->delete;
 200
 201 # test populate
 202   lives_ok (sub {
 203     my @pop;
 204     for (1..2) {
 205       push @pop, { name => "Artist_$_" };
 206     }
 207     $ars->populate (\@pop);
 208   });
 209
 210 # test populate with explicit key
 211   lives_ok (sub {
 212     my @pop;
 213     for (1..2) {
 214       push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
 215     }
 216     $ars->populate (\@pop);
 217   });
 218
 219 # count what we did so far
 220   is ($ars->count, 6, 'Simple count works');
 221
 222 # test LIMIT support
 223 # not testing offset because access only supports TOP
 224   my $lim = $ars->search( {},
 225     {
 226       rows => 2,
 227       offset => 0,
 228       order_by => 'artistid'
 229     }
 230   );
 231   is( $lim->count, 2, 'ROWS+OFFSET count ok' );
 232   is( $lim->all, 2, 'Number of ->all objects matches count' );
 233
 234 # test iterator
 235   $lim->reset;
 236   is( $lim->next->artistid, 1, "iterator->next ok" );
 237   is( $lim->next->artistid, 66, "iterator->next ok" );
 238   is( $lim->next, undef, "next past end of resultset ok" );
 239
 240 # test empty insert
 241   my $current_artistid = $ars->search({}, {
 242     select => [ { max => 'artistid' } ], as => ['artistid']
 243   })->first->artistid;
 244
 245   my $row;
 246   lives_ok { $row = $ars->create({}) }
 247     'empty insert works';
 248
 249   $row->discard_changes;
 250
 251   is $row->artistid, $current_artistid+1,
 252     'empty insert generated correct PK';
 253
 254 # test that autoinc column still works after empty insert
 255   $row = $ars->create({ name => 'after_empty_insert' });
 256
 257   is $row->artistid, $current_artistid+2,
 258     'autoincrement column functional aftear empty insert';
 259
 260 # test blobs (stolen from 73oracle.t)
 261
 262 # turn off horrendous binary DBIC_TRACE output
 263   {
 264     local $schema->storage->{debug} = 0;
 265
 266     eval { local $^W = 0; $dbh->do('DROP TABLE bindtype_test') };
 267     $dbh->do(qq[
 268     CREATE TABLE bindtype_test
 269     (
 270       id     INT          NOT NULL PRIMARY KEY,
 271       bytea  INT          NULL,
 272       blob   IMAGE        NULL,
 273       clob   TEXT         NULL,
 274       a_memo MEMO         NULL
 275     )
 276     ],{ RaiseError => 1, PrintError => 1 });
 277
 278     my $rs = $schema->resultset('BindType');
 279     my $id = 0;
 280
 281     foreach my $type (qw( blob clob a_memo )) {
 282       foreach my $size (qw( small large )) {
 283         SKIP: {
 284           skip 'TEXT columns not cast to MEMO over ODBC', 2
 285             if $type eq 'clob' && $size eq 'large' && $dsn =~ /:ODBC:/;
 286
 287           $id++;
 288
 289           lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
 290             "inserted $size $type without dying" or next;
 291
 292           my $from_db = eval { $rs->find($id)->$type } || '';
 293           diag $@ if $@;
 294
 295           ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
 296             or do {
 297               my $hexdump = sub {
 298                 join '', map sprintf('%02X', ord), split //, shift
 299               };
 300               diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
 301                 substr($hexdump->($from_db),-255);
 302               diag 'Size: ', length($from_db);
 303               diag 'Expected Size: ', length($binstr{$size});
 304               diag 'Expected: ', "\n",
 305                 substr($hexdump->($binstr{$size}), 0, 255),
 306                 "...", substr($hexdump->($binstr{$size}),-255);
 307             };
 308         }
 309       }
 310     }
 311 # test IMAGE update
 312     lives_ok {
 313       $rs->search({ id => 0 })->update({ blob => $binstr{small} });
 314     } 'updated IMAGE to small binstr without dying';
 315
 316     lives_ok {
 317       $rs->search({ id => 0 })->update({ blob => $binstr{large} });
 318     } 'updated IMAGE to large binstr without dying';
 319   }
 320
 321 # test GUIDs (and the cursor GUID fixup stuff for ADO)
 322
 323   require Data::GUID;
 324   $schema->storage->new_guid(sub { Data::GUID->new->as_string });
 325
 326   local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
 327     = 'guid';
 328
 329   local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
 330     = 'guid';
 331
 332   $schema->storage->dbh_do (sub {
 333     my ($storage, $dbh) = @_;
 334     eval { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
 335     $dbh->do(<<"SQL");
 336 CREATE TABLE artist_guid (
 337    artistid GUID NOT NULL,
 338    name VARCHAR(100),
 339    rank INT NULL,
 340    charfield CHAR(10) NULL,
 341    a_guid GUID,
 342    primary key(artistid)
 343 )
 344 SQL
 345   });
 346
 347   lives_ok {
 348     $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
 349   } 'created a row with a GUID';
 350
 351   ok(
 352     eval { $row->artistid },
 353     'row has GUID PK col populated',
 354   );
 355   diag $@ if $@;
 356
 357   ok(
 358     eval { $row->a_guid },
 359     'row has a GUID col with auto_nextval populated',
 360   );
 361   diag $@ if $@;
 362
 363   my $row_from_db = $schema->resultset('ArtistGUID')
 364     ->search({ name => 'mtfnpy' })->first;
 365
 366   is $row_from_db->artistid, $row->artistid,
 367     'PK GUID round trip (via ->search->next)';
 368
 369   is $row_from_db->a_guid, $row->a_guid,
 370     'NON-PK GUID round trip (via ->search->next)';
 371
 372   $row_from_db = $schema->resultset('ArtistGUID')
 373     ->find($row->artistid);
 374
 375   is $row_from_db->artistid, $row->artistid,
 376     'PK GUID round trip (via ->find)';
 377
 378   is $row_from_db->a_guid, $row->a_guid,
 379     'NON-PK GUID round trip (via ->find)';
 380
 381   ($row_from_db) = $schema->resultset('ArtistGUID')
 382     ->search({ name => 'mtfnpy' })->all;
 383
 384   is $row_from_db->artistid, $row->artistid,
 385     'PK GUID round trip (via ->search->all)';
 386
 387   is $row_from_db->a_guid, $row->a_guid,
 388     'NON-PK GUID round trip (via ->search->all)';
 389 }
 390
 391 done_testing;
 392
 393 sub cleanup {
 394   if (my $storage = eval { $schema->storage }) {
 395     # cannot drop a table if it has been used, have to reconnect first
 396     $schema->storage->disconnect;
 397     local $^W = 0; # for ADO OLE exceptions
 398     $schema->storage->dbh->do("DROP TABLE $_")
 399       for qw/artist track cd bindtype_test artist_guid/;
 400   }
 401 }
 402
 403 # vim:sts=2 sw=2: