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