11 DBICTest::Schema->load_classes('ArtistGUID');
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'
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/};
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'.
25 plan skip_all => 'Test needs ' .
26 DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_odbc')
28 DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_msaccess_ado')
30 DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_odbc')
32 DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_msaccess_ado');
35 [ $dsn, $user || '', $pass || '' ],
36 [ $dsn2, $user2 || '', $pass2 || '' ],
41 foreach my $info (@info) {
42 my ($dsn, $user, $pass) = @$info;
46 # Check that we can connect without any options.
47 $schema = DBICTest::Schema->connect($dsn, $user, $pass);
49 $schema->storage->ensure_connected;
50 } 'connection without any options';
52 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
53 $binstr{'large'} = $binstr{'small'} x 1024;
55 my $maxloblen = length $binstr{'large'};
57 $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
60 LongReadLen => $maxloblen,
63 my $guard = Scope::Guard->new(\&cleanup);
65 my $dbh = $schema->storage->dbh;
67 # turn off warnings for OLE exception from ADO about nonexistant table
68 eval { local $^W = 0; $dbh->do("DROP TABLE artist") };
72 artistid AUTOINCREMENT PRIMARY KEY,
73 name VARCHAR(255) NULL,
74 charfield CHAR(10) NULL,
79 my $ars = $schema->resultset('Artist');
80 is ( $ars->count, 0, 'No rows at first' );
82 # test primary key handling
83 my $new = $ars->create({ name => 'foo' });
84 ok($new->artistid, "Auto-PK worked");
86 my $first_artistid = $new->artistid;
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');
95 eval { local $^W = 0; $dbh->do("DROP TABLE cd") };
99 cdid AUTOINCREMENT PRIMARY KEY,
101 title VARCHAR(255) NULL,
103 genreid INTEGER NULL,
104 single_track INTEGER NULL
110 trackid AUTOINCREMENT PRIMARY KEY,
111 cd INTEGER REFERENCES cd(cdid),
114 last_updated_on DATETIME,
115 last_updated_at DATETIME
119 my $cd = $schema->resultset('CD')->create({
120 artist => $first_artistid,
121 title => 'Some Album',
125 my $joined_artist = $schema->resultset('Artist')->search({
126 artistid => $first_artistid,
129 '+select' => [ 'cds.title' ],
130 '+as' => [ 'cd_title' ],
133 is $joined_artist->get_column('cd_title'), 'Some Album',
134 'one-step join works';
137 my $track = $schema->resultset('Track')->create({
143 my $joined_track = try {
144 $schema->resultset('Artist')->search({
145 artistid => $first_artistid,
147 join => [{ cds => 'tracks' }],
148 '+select' => [ 'tracks.title' ],
149 '+as' => [ 'track_title' ],
153 diag "Could not execute two-step join: $_";
156 is try { $joined_track->get_column('track_title') }, 'my track',
157 'two-step join works';
159 # test basic transactions
160 $schema->txn_do(sub {
161 $ars->create({ name => 'transaction_commit' });
163 ok($ars->search({ name => 'transaction_commit' })->first,
164 'transaction committed');
165 $ars->search({ name => 'transaction_commit' })->delete,
167 $schema->txn_do(sub {
168 $ars->create({ name => 'transaction_rollback' });
171 } qr/rolling back/, 'rollback executed';
172 is $ars->search({ name => 'transaction_rollback' })->first, undef,
173 'transaction rolled back';
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' });
181 ok($ars->search({ name => 'in_inner_transaction' })->first,
182 'commit from inner transaction visible in outer transaction');
184 $schema->txn_do(sub {
185 $ars->create({ name => 'in_inner_transaction_rolling_back' });
186 die 'rolling back inner transaction';
188 } qr/rolling back inner transaction/, 'inner transaction rollback executed';
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,
196 'rollback from inner transaction';
197 $ars->search({ name => 'in_outer_transaction' })->delete;
198 $ars->search({ name => 'in_inner_transaction' })->delete;
204 push @pop, { name => "Artist_$_" };
206 $ars->populate (\@pop);
209 # test populate with explicit key
213 push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
215 $ars->populate (\@pop);
218 # count what we did so far
219 is ($ars->count, 6, 'Simple count works');
222 # not testing offset because access only supports TOP
223 my $lim = $ars->search( {},
227 order_by => 'artistid'
230 is( $lim->count, 2, 'ROWS+OFFSET count ok' );
231 is( $lim->all, 2, 'Number of ->all objects matches count' );
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" );
240 my $current_artistid = $ars->search({}, {
241 select => [ { max => 'artistid' } ], as => ['artistid']
245 lives_ok { $row = $ars->create({}) }
246 'empty insert works';
248 $row->discard_changes;
250 is $row->artistid, $current_artistid+1,
251 'empty insert generated correct PK';
253 # test that autoinc column still works after empty insert
254 $row = $ars->create({ name => 'after_empty_insert' });
256 is $row->artistid, $current_artistid+2,
257 'autoincrement column functional aftear empty insert';
259 # test blobs (stolen from 73oracle.t)
261 # turn off horrendous binary DBIC_TRACE output
263 local $schema->storage->{debug} = 0;
265 eval { local $^W = 0; $dbh->do('DROP TABLE bindtype_test') };
267 CREATE TABLE bindtype_test
269 id INT NOT NULL PRIMARY KEY,
275 ],{ RaiseError => 1, PrintError => 1 });
277 my $rs = $schema->resultset('BindType');
280 foreach my $type (qw( blob clob a_memo )) {
281 foreach my $size (qw( small large )) {
283 skip 'TEXT columns not cast to MEMO over ODBC', 2
284 if $type eq 'clob' && $size eq 'large' && $dsn =~ /:ODBC:/;
288 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
289 "inserted $size $type without dying" or next;
291 my $from_db = eval { $rs->find($id)->$type } || '';
294 ok($from_db eq $binstr{$size}, "verified inserted $size $type" )
297 join '', map sprintf('%02X', ord), split //, shift
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);
312 $rs->search({ id => 0 })->update({ blob => $binstr{small} });
313 } 'updated IMAGE to small binstr without dying';
316 $rs->search({ id => 0 })->update({ blob => $binstr{large} });
317 } 'updated IMAGE to large binstr without dying';
320 # test GUIDs (and the cursor GUID fixup stuff for ADO)
323 $schema->storage->new_guid(sub { Data::GUID->new->as_string });
325 local $schema->source('ArtistGUID')->column_info('artistid')->{data_type}
328 local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type}
331 $schema->storage->dbh_do (sub {
332 my ($storage, $dbh) = @_;
333 eval { local $^W = 0; $dbh->do("DROP TABLE artist_guid") };
335 CREATE TABLE artist_guid (
336 artistid GUID NOT NULL,
339 charfield CHAR(10) NULL,
341 primary key(artistid)
347 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
348 } 'created a row with a GUID';
351 eval { $row->artistid },
352 'row has GUID PK col populated',
357 eval { $row->a_guid },
358 'row has a GUID col with auto_nextval populated',
362 my $row_from_db = $schema->resultset('ArtistGUID')
363 ->search({ name => 'mtfnpy' })->first;
365 is $row_from_db->artistid, $row->artistid,
366 'PK GUID round trip (via ->search->next)';
368 is $row_from_db->a_guid, $row->a_guid,
369 'NON-PK GUID round trip (via ->search->next)';
371 $row_from_db = $schema->resultset('ArtistGUID')
372 ->find($row->artistid);
374 is $row_from_db->artistid, $row->artistid,
375 'PK GUID round trip (via ->find)';
377 is $row_from_db->a_guid, $row->a_guid,
378 'NON-PK GUID round trip (via ->find)';
380 ($row_from_db) = $schema->resultset('ArtistGUID')
381 ->search({ name => 'mtfnpy' })->all;
383 is $row_from_db->artistid, $row->artistid,
384 'PK GUID round trip (via ->search->all)';
386 is $row_from_db->a_guid, $row->a_guid,
387 'NON-PK GUID round trip (via ->search->all)';
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/;