Only load DBICTest::Schema when needed in tests
[dbsrgits/DBIx-Class.git] / 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 DBIx::Class::Optional::Dependencies ();
9 use lib qw(t/lib);
10 use DBICTest;
11
12 my ($dsn,  $user,  $pass)  = @ENV{map { "DBICTEST_MSACCESS_ODBC_${_}" } qw/DSN USER PASS/};
13 my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_MSACCESS_ADO_${_}" }  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_msaccess_odbc'),
18     DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado'))
19   unless
20     $dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
21     or
22     $dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado')
23     or
24     (not $dsn || $dsn2);
25
26 require DBICTest::Schema;
27 DBICTest::Schema->load_classes('ArtistGUID');
28
29 # Example DSNs (32bit only):
30 # dbi:ODBC:driver={Microsoft Access Driver (*.mdb, *.accdb)};dbq=C:\Users\rkitover\Documents\access_sample.accdb
31 # dbi:ADO:Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb
32 # dbi:ADO:Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\rkitover\Documents\access_sample.accdb;Persist Security Info=False'
33
34 plan skip_all => <<'EOF' unless $dsn || $dsn2;
35 Set $ENV{DBICTEST_MSACCESS_ODBC_DSN} and/or $ENV{DBICTEST_MSACCESS_ADO_DSN} (and optionally _USER and _PASS) to run these tests.
36 Warning: this test drops and creates the tables 'artist', 'cd', 'bindtype_test' and 'artist_guid'.
37 EOF
38
39 my @info = (
40   [ $dsn,  $user  || '', $pass  || '' ],
41   [ $dsn2, $user2 || '', $pass2 || '' ],
42 );
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   my $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(sub { cleanup($schema) });
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 $joined_track = try {
147     $schema->resultset('Artist')->search({
148       artistid => $first_artistid,
149     }, {
150       join => [{ cds => 'tracks' }],
151       '+select' => [ 'tracks.title' ],
152       '+as'     => [ 'track_title'  ],
153     })->next;
154   }
155   catch {
156     diag "Could not execute two-step left join: $_";
157   };
158
159   is try { $joined_track->get_column('track_title') }, 'my track',
160     'two-step left join works';
161
162   $joined_artist = try {
163     $schema->resultset('Track')->search({
164       trackid => $track->trackid,
165     }, {
166       join => [{ cd => 'artist' }],
167       '+select' => [ 'artist.name' ],
168       '+as'     => [ 'artist_name'  ],
169     })->next;
170   }
171   catch {
172     diag "Could not execute two-step inner join: $_";
173   };
174
175   is try { $joined_artist->get_column('artist_name') }, 'foo',
176     'two-step inner join works';
177
178 # test basic transactions
179   $schema->txn_do(sub {
180     $ars->create({ name => 'transaction_commit' });
181   });
182   ok($ars->search({ name => 'transaction_commit' })->first,
183     'transaction committed');
184   $ars->search({ name => 'transaction_commit' })->delete,
185   throws_ok {
186     $schema->txn_do(sub {
187       $ars->create({ name => 'transaction_rollback' });
188       die 'rolling back';
189     });
190   } qr/rolling back/, 'rollback executed';
191   is $ars->search({ name => 'transaction_rollback' })->first, undef,
192     'transaction rolled back';
193
194 # test two-phase commit and inner transaction rollback from nested transactions
195   $schema->txn_do(sub {
196     $ars->create({ name => 'in_outer_transaction' });
197     $schema->txn_do(sub {
198       $ars->create({ name => 'in_inner_transaction' });
199     });
200     ok($ars->search({ name => 'in_inner_transaction' })->first,
201       'commit from inner transaction visible in outer transaction');
202     throws_ok {
203       $schema->txn_do(sub {
204         $ars->create({ name => 'in_inner_transaction_rolling_back' });
205         die 'rolling back inner transaction';
206       });
207     } qr/rolling back inner transaction/, 'inner transaction rollback executed';
208   });
209   ok($ars->search({ name => 'in_outer_transaction' })->first,
210     'commit from outer transaction');
211   ok($ars->search({ name => 'in_inner_transaction' })->first,
212     'commit from inner transaction');
213   is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
214     undef,
215     'rollback from inner transaction';
216   $ars->search({ name => 'in_outer_transaction' })->delete;
217   $ars->search({ name => 'in_inner_transaction' })->delete;
218
219 # test populate
220   lives_ok (sub {
221     my @pop;
222     for (1..2) {
223       push @pop, { name => "Artist_$_" };
224     }
225     $ars->populate (\@pop);
226   });
227
228 # test populate with explicit key
229   lives_ok (sub {
230     my @pop;
231     for (1..2) {
232       push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
233     }
234     $ars->populate (\@pop);
235   });
236
237 # count what we did so far
238   is ($ars->count, 6, 'Simple count works');
239
240 # test LIMIT support
241 # not testing offset because access only supports TOP
242   my $lim = $ars->search( {},
243     {
244       rows => 2,
245       offset => 0,
246       order_by => 'artistid'
247     }
248   );
249   is( $lim->count, 2, 'ROWS+OFFSET count ok' );
250   is( $lim->all, 2, 'Number of ->all objects matches count' );
251
252 # test iterator
253   $lim->reset;
254   is( $lim->next->artistid, 1, "iterator->next ok" );
255   is( $lim->next->artistid, 66, "iterator->next ok" );
256   is( $lim->next, undef, "next past end of resultset ok" );
257
258 # test empty insert
259   my $current_artistid = $ars->search({}, {
260     select => [ { max => 'artistid' } ], as => ['artistid']
261   })->first->artistid;
262
263   my $row;
264   lives_ok { $row = $ars->create({}) }
265     'empty insert works';
266
267   $row->discard_changes;
268
269   is $row->artistid, $current_artistid+1,
270     'empty insert generated correct PK';
271
272 # test that autoinc column still works after empty insert
273   $row = $ars->create({ name => 'after_empty_insert' });
274
275   is $row->artistid, $current_artistid+2,
276     'autoincrement column functional aftear empty insert';
277
278 # test blobs (stolen from 73oracle.t)
279
280 # turn off horrendous binary DBIC_TRACE output
281   {
282     local $schema->storage->{debug} = 0;
283
284     eval { local $^W = 0; $dbh->do('DROP TABLE bindtype_test') };
285     $dbh->do(qq[
286     CREATE TABLE bindtype_test
287     (
288       id     INT          NOT NULL PRIMARY KEY,
289       bytea  INT          NULL,
290       blob   IMAGE        NULL,
291       clob   TEXT         NULL,
292       a_memo MEMO         NULL
293     )
294     ],{ RaiseError => 1, PrintError => 1 });
295
296     my $rs = $schema->resultset('BindType');
297     my $id = 0;
298
299     foreach my $type (qw( blob clob a_memo )) {
300       foreach my $size (qw( small large )) {
301         SKIP: {
302           skip 'TEXT columns not cast to MEMO over ODBC', 2
303             if $type eq 'clob' && $size eq 'large' && $dsn =~ /:ODBC:/;
304
305           $id++;
306
307           lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
308             "inserted $size $type without dying" or next;
309
310           my $from_db = eval { $rs->find($id)->$type } || '';
311           diag $@ if $@;
312
313           ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
314             or do {
315               my $hexdump = sub {
316                 join '', map sprintf('%02X', ord), split //, shift
317               };
318               diag 'Got: ', "\n", substr($hexdump->($from_db),0,255), '...',
319                 substr($hexdump->($from_db),-255);
320               diag 'Size: ', length($from_db);
321               diag 'Expected Size: ', length($binstr{$size});
322               diag 'Expected: ', "\n",
323                 substr($hexdump->($binstr{$size}), 0, 255),
324                 "...", substr($hexdump->($binstr{$size}),-255);
325             };
326         }
327       }
328     }
329 # test IMAGE update
330     lives_ok {
331       $rs->search({ id => 0 })->update({ blob => $binstr{small} });
332     } 'updated IMAGE to small binstr without dying';
333
334     lives_ok {
335       $rs->search({ id => 0 })->update({ blob => $binstr{large} });
336     } 'updated IMAGE to large binstr without dying';
337   }
338
339 # test GUIDs (and the cursor GUID fixup stuff for ADO)
340
341   require Data::GUID;
342   $schema->storage->new_guid(sub { Data::GUID->new->as_string });
343
344   local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
345     = 'guid';
346
347   local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
348     = 'guid';
349
350   $schema->storage->dbh_do (sub {
351     my ($storage, $dbh) = @_;
352     eval { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
353     $dbh->do(<<"SQL");
354 CREATE TABLE artist_guid (
355    artistid GUID NOT NULL,
356    name VARCHAR(100),
357    rank INT NULL,
358    charfield CHAR(10) NULL,
359    a_guid GUID,
360    primary key(artistid)
361 )
362 SQL
363   });
364
365   lives_ok {
366     $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
367   } 'created a row with a GUID';
368
369   ok(
370     eval { $row->artistid },
371     'row has GUID PK col populated',
372   );
373   diag $@ if $@;
374
375   ok(
376     eval { $row->a_guid },
377     'row has a GUID col with auto_nextval populated',
378   );
379   diag $@ if $@;
380
381   my $row_from_db = $schema->resultset('ArtistGUID')
382     ->search({ name => 'mtfnpy' })->first;
383
384   is $row_from_db->artistid, $row->artistid,
385     'PK GUID round trip (via ->search->next)';
386
387   is $row_from_db->a_guid, $row->a_guid,
388     'NON-PK GUID round trip (via ->search->next)';
389
390   $row_from_db = $schema->resultset('ArtistGUID')
391     ->find($row->artistid);
392
393   is $row_from_db->artistid, $row->artistid,
394     'PK GUID round trip (via ->find)';
395
396   is $row_from_db->a_guid, $row->a_guid,
397     'NON-PK GUID round trip (via ->find)';
398
399   ($row_from_db) = $schema->resultset('ArtistGUID')
400     ->search({ name => 'mtfnpy' })->all;
401
402   is $row_from_db->artistid, $row->artistid,
403     'PK GUID round trip (via ->search->all)';
404
405   is $row_from_db->a_guid, $row->a_guid,
406     'NON-PK GUID round trip (via ->search->all)';
407 }
408
409 done_testing;
410
411 sub cleanup {
412   my $schema = shift;
413
414   if (my $storage = eval { $schema->storage }) {
415     # cannot drop a table if it has been used, have to reconnect first
416     $schema->storage->disconnect;
417     local $^W = 0; # for ADO OLE exceptions
418     $schema->storage->dbh->do("DROP TABLE $_")
419       for qw/artist track cd bindtype_test artist_guid/;
420   }
421 }
422
423 # vim:sts=2 sw=2: