Commit | Line | Data |
726c8f65 |
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; |
696ba760 |
10 | use DBIC::DebugObj (); |
11 | use DBIC::SqlMakerTest; |
726c8f65 |
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; |
076bd599 |
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'. |
726c8f65 |
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 | |
696ba760 |
146 | my ($sql, @bind); |
147 | |
726c8f65 |
148 | my $joined_track = try { |
696ba760 |
149 | local $schema->storage->{debug} = 1; |
150 | local $schema->storage->{debugobj} = DBIC::DebugObj->new(\$sql, \@bind); |
151 | |
726c8f65 |
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 { |
696ba760 |
161 | diag "Could not execute two-step left join: $_"; |
726c8f65 |
162 | }; |
163 | |
696ba760 |
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 | |
726c8f65 |
174 | is try { $joined_track->get_column('track_title') }, 'my track', |
696ba760 |
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'; |
726c8f65 |
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: |