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