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