Commit | Line | Data |
c1cac633 |
1 | use strict; |
b9a2c3a5 |
2 | use warnings; |
c1cac633 |
3 | |
4 | use Test::More; |
893403c8 |
5 | use Test::Exception; |
c1cac633 |
6 | use lib qw(t/lib); |
7 | use DBICTest; |
b2d16f1f |
8 | use DBIC::SqlMakerTest; |
384b8bce |
9 | use Try::Tiny; |
c1cac633 |
10 | |
fcb7fcbb |
11 | use DBIx::Class::SQLMaker::LimitDialects; |
12 | my $OFFSET = DBIx::Class::SQLMaker::LimitDialects->__offset_bindtype; |
13 | my $TOTAL = DBIx::Class::SQLMaker::LimitDialects->__total_bindtype; |
14 | |
c1cac633 |
15 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; |
16 | |
17 | plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test' |
18 | unless ($dsn && $user); |
19 | |
77c7628c |
20 | { |
21 | my $srv_ver = DBICTest::Schema->connect($dsn, $user, $pass)->storage->_server_info->{dbms_version}; |
22 | ok ($srv_ver, 'Got a test server version on fresh schema: ' . ($srv_ver||'???') ); |
23 | } |
24 | |
ca791b95 |
25 | DBICTest::Schema->load_classes('ArtistGUID'); |
42e5b103 |
26 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
c1cac633 |
27 | |
8c0104fe |
28 | { |
29 | no warnings 'redefine'; |
30 | my $connect_count = 0; |
31 | my $orig_connect = \&DBI::connect; |
32 | local *DBI::connect = sub { $connect_count++; goto &$orig_connect }; |
33 | |
34 | $schema->storage->ensure_connected; |
35 | |
36 | is( $connect_count, 1, 'only one connection made'); |
37 | } |
9b3e916d |
38 | |
c1cac633 |
39 | isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' ); |
40 | |
cf89555e |
41 | { |
42 | my $schema2 = $schema->connect ($schema->storage->connect_info); |
43 | ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected'); |
44 | } |
45 | |
ecdf1ac8 |
46 | $schema->storage->_dbh->disconnect; |
47 | |
48 | lives_ok { |
49 | $schema->storage->dbh_do(sub { $_[1]->do('select 1') }) |
50 | } '_ping works'; |
51 | |
384b8bce |
52 | my %opts = ( |
53 | use_mars => |
54 | { on_connect_call => 'use_mars' }, |
55 | use_dynamic_cursors => |
56 | { on_connect_call => 'use_dynamic_cursors' }, |
57 | use_server_cursors => |
58 | { on_connect_call => 'use_server_cursors' }, |
59 | plain => |
60 | {}, |
61 | ); |
62 | |
63 | for my $opts_name (keys %opts) { |
64 | SKIP: { |
65 | my $opts = $opts{$opts_name}; |
66 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
67 | |
68 | try { |
69 | $schema->storage->ensure_connected |
70 | } |
71 | catch { |
72 | skip "$opts_name not functional in this configuration: $_", 1; |
73 | }; |
74 | |
e56b1c2d |
75 | $schema->storage->dbh_do (sub { |
76 | my ($storage, $dbh) = @_; |
77 | eval { $dbh->do("DROP TABLE artist") }; |
78 | $dbh->do(<<'SQL'); |
c1cac633 |
79 | CREATE TABLE artist ( |
80 | artistid INT IDENTITY NOT NULL, |
a0dd8679 |
81 | name VARCHAR(100), |
39da2a2b |
82 | rank INT NOT NULL DEFAULT '13', |
2eebd801 |
83 | charfield CHAR(10) NULL, |
c1cac633 |
84 | primary key(artistid) |
85 | ) |
c5f77f6c |
86 | SQL |
e56b1c2d |
87 | }); |
c5f77f6c |
88 | |
384b8bce |
89 | # test Auto-PK |
90 | $schema->resultset('Artist')->search({ name => 'foo' })->delete; |
c1cac633 |
91 | |
384b8bce |
92 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
7b1b2582 |
93 | |
384b8bce |
94 | ok(($new->artistid||0) > 0, "Auto-PK worked for $opts_name"); |
7b1b2582 |
95 | |
384b8bce |
96 | # Test multiple active statements |
97 | SKIP: { |
98 | skip 'not a multiple active statements configuration', 1 |
99 | if $opts_name eq 'plain'; |
41dd5d30 |
100 | |
384b8bce |
101 | my $artist_rs = $schema->resultset('Artist'); |
41dd5d30 |
102 | |
384b8bce |
103 | $artist_rs->delete; |
c1cac633 |
104 | |
384b8bce |
105 | $artist_rs->create({ name => "Artist$_" }) for (1..3); |
ca791b95 |
106 | |
384b8bce |
107 | my $forward = $artist_rs->search({}, |
108 | { order_by => { -asc => 'artistid' } }); |
109 | my $backward = $artist_rs->search({}, |
110 | { order_by => { -desc => 'artistid' } }); |
111 | |
112 | my @map = ( |
113 | [qw/Artist1 Artist3/], [qw/Artist2 Artist2/], [qw/Artist3 Artist1/] |
114 | ); |
115 | my @result; |
116 | |
117 | while (my $forward_row = $forward->next) { |
118 | my $backward_row = $backward->next; |
119 | push @result, [$forward_row->name, $backward_row->name]; |
120 | } |
121 | |
122 | is_deeply \@result, \@map, "multiple active statements in $opts_name"; |
123 | |
124 | $artist_rs->delete; |
125 | } |
ca791b95 |
126 | |
a54bd479 |
127 | # Test populate |
f6b185e1 |
128 | |
e56b1c2d |
129 | { |
130 | $schema->storage->dbh_do (sub { |
131 | my ($storage, $dbh) = @_; |
132 | eval { $dbh->do("DROP TABLE owners") }; |
133 | eval { $dbh->do("DROP TABLE books") }; |
134 | $dbh->do(<<'SQL'); |
02495deb |
135 | CREATE TABLE books ( |
b9a2c3a5 |
136 | id INT IDENTITY (1, 1) NOT NULL, |
137 | source VARCHAR(100), |
138 | owner INT, |
139 | title VARCHAR(10), |
140 | price INT NULL |
141 | ) |
142 | |
02495deb |
143 | CREATE TABLE owners ( |
b9a2c3a5 |
144 | id INT IDENTITY (1, 1) NOT NULL, |
42e5b103 |
145 | name VARCHAR(100), |
b9a2c3a5 |
146 | ) |
b9a2c3a5 |
147 | SQL |
a54bd479 |
148 | }); |
149 | |
e56b1c2d |
150 | lives_ok ( sub { |
151 | # start a new connection, make sure rebless works |
152 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
153 | $schema->populate ('Owners', [ |
154 | [qw/id name /], |
155 | [qw/1 wiggle/], |
156 | [qw/2 woggle/], |
157 | [qw/3 boggle/], |
158 | [qw/4 fRIOUX/], |
159 | [qw/5 fRUE/], |
160 | [qw/6 fREW/], |
161 | [qw/7 fROOH/], |
162 | [qw/8 fISMBoC/], |
163 | [qw/9 station/], |
164 | [qw/10 mirror/], |
165 | [qw/11 dimly/], |
166 | [qw/12 face_to_face/], |
167 | [qw/13 icarus/], |
168 | [qw/14 dream/], |
169 | [qw/15 dyrstyggyr/], |
170 | ]); |
171 | }, 'populate with PKs supplied ok' ); |
172 | |
173 | |
174 | lives_ok (sub { |
175 | # start a new connection, make sure rebless works |
176 | # test an insert with a supplied identity, followed by one without |
177 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
178 | for (2, 1) { |
179 | my $id = $_ * 20 ; |
180 | $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" }); |
181 | $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) }); |
182 | } |
183 | }, 'create with/without PKs ok' ); |
184 | |
185 | is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' ); |
186 | |
187 | lives_ok ( sub { |
188 | # start a new connection, make sure rebless works |
189 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
190 | $schema->populate ('BooksInLibrary', [ |
191 | [qw/source owner title /], |
192 | [qw/Library 1 secrets0/], |
193 | [qw/Library 1 secrets1/], |
194 | [qw/Eatery 1 secrets2/], |
195 | [qw/Library 2 secrets3/], |
196 | [qw/Library 3 secrets4/], |
197 | [qw/Eatery 3 secrets5/], |
198 | [qw/Library 4 secrets6/], |
199 | [qw/Library 5 secrets7/], |
200 | [qw/Eatery 5 secrets8/], |
201 | [qw/Library 6 secrets9/], |
202 | [qw/Library 7 secrets10/], |
203 | [qw/Eatery 7 secrets11/], |
204 | [qw/Library 8 secrets12/], |
205 | ]); |
206 | }, 'populate without PKs supplied ok' ); |
a54bd479 |
207 | } |
fb7cd45f |
208 | |
e56b1c2d |
209 | # test simple, complex LIMIT and limited prefetch support, with both dialects and quote combinations (if possible) |
210 | for my $dialect ( |
211 | 'Top', |
212 | ($schema->storage->_server_info->{normalized_dbms_version} || 0 ) >= 9 |
213 | ? ('RowNumberOver') |
214 | : () |
215 | , |
216 | ) { |
217 | for my $quoted (0, 1) { |
218 | |
219 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, { |
220 | limit_dialect => $dialect, |
221 | %$opts, |
222 | $quoted |
223 | ? ( quote_char => [ qw/ [ ] / ], name_sep => '.' ) |
224 | : () |
225 | , |
226 | }); |
227 | |
228 | my $test_type = "Dialect:$dialect Quoted:$quoted"; |
229 | |
230 | # basic limit support |
231 | TODO: { |
232 | my $art_rs = $schema->resultset ('Artist'); |
233 | $art_rs->delete; |
234 | $art_rs->create({ name => 'Artist ' . $_ }) for (1..6); |
235 | |
236 | my $it = $schema->resultset('Artist')->search( {}, { |
237 | rows => 4, |
238 | offset => 3, |
239 | order_by => 'artistid', |
240 | }); |
241 | |
242 | is( $it->count, 3, "$test_type: LIMIT count ok" ); |
243 | |
244 | local $TODO = "Top-limit does not work when your limit ends up past the resultset" |
245 | if $dialect eq 'Top'; |
246 | |
247 | is( $it->next->name, 'Artist 4', "$test_type: iterator->next ok" ); |
248 | $it->next; |
249 | is( $it->next->name, 'Artist 6', "$test_type: iterator->next ok" ); |
250 | is( $it->next, undef, "$test_type: next past end of resultset ok" ); |
251 | } |
f0bd60fc |
252 | |
e56b1c2d |
253 | # plain ordered subqueries throw |
254 | throws_ok (sub { |
255 | $schema->resultset('Owners')->search ({}, { order_by => 'name' })->as_query |
256 | }, qr/ordered subselect encountered/, "$test_type: Ordered Subselect detection throws ok"); |
a54bd479 |
257 | |
e56b1c2d |
258 | # make sure ordered subselects *somewhat* work |
259 | { |
260 | my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 }); |
261 | my $sealed_owners = $owners->as_subselect_rs; |
262 | |
263 | is_deeply ( |
264 | [ map { $_->name } ($sealed_owners->all) ], |
265 | [ map { $_->name } ($owners->all) ], |
266 | "$test_type: Sort preserved from within a subquery", |
267 | ); |
268 | } |
a54bd479 |
269 | |
e56b1c2d |
270 | { |
271 | my $book_owner_ids = $schema->resultset ('BooksInLibrary')->search ({}, { |
272 | rows => 6, |
273 | offset => 2, |
274 | join => 'owner', |
275 | distinct => 1, |
276 | order_by => 'owner.name', |
277 | unsafe_subselect_ok => 1 |
278 | })->get_column ('owner'); |
279 | |
280 | my @ids = $book_owner_ids->all; |
281 | |
282 | is (@ids, 6, 'Limit works'); |
283 | |
284 | my $book_owners = $schema->resultset ('Owners')->search ({ |
285 | id => { -in => $book_owner_ids->as_query } |
286 | }); |
287 | |
288 | TODO: { |
289 | local $TODO = "Correlated limited IN subqueries will probably never preserve order"; |
290 | |
291 | is_deeply ( |
292 | [ map { $_->id } ($book_owners->all) ], |
293 | [ $book_owner_ids->all ], |
294 | "$test_type: Sort is preserved across IN subqueries", |
295 | ); |
296 | } |
297 | } |
a54bd479 |
298 | |
e56b1c2d |
299 | # still even with lost order of IN, we should be getting correct |
300 | # sets |
301 | { |
302 | my $owners = $schema->resultset ('Owners')->search ({}, { order_by => 'name', offset => 2, rows => 3, unsafe_subselect_ok => 1 }); |
303 | my $corelated_owners = $owners->result_source->resultset->search ( |
304 | { |
305 | id => { -in => $owners->get_column('id')->as_query }, |
306 | }, |
307 | { |
308 | order_by => 'name' #reorder because of what is shown above |
309 | }, |
310 | ); |
311 | |
312 | is ( |
313 | join ("\x00", map { $_->name } ($corelated_owners->all) ), |
314 | join ("\x00", map { $_->name } ($owners->all) ), |
315 | "$test_type: With an outer order_by, everything still matches", |
316 | ); |
317 | } |
a54bd479 |
318 | |
e56b1c2d |
319 | # make sure right-join-side single-prefetch ordering limit works |
320 | { |
321 | my $rs = $schema->resultset ('BooksInLibrary')->search ( |
322 | { |
323 | 'owner.name' => { '!=', 'woggle' }, |
324 | }, |
325 | { |
326 | prefetch => 'owner', |
327 | order_by => 'owner.name', |
328 | } |
329 | ); |
330 | # this is the order in which they should come from the above query |
331 | my @owner_names = qw/boggle fISMBoC fREW fRIOUX fROOH fRUE wiggle wiggle/; |
332 | |
333 | is ($rs->all, 8, "$test_type: Correct amount of objects from right-sorted joined resultset"); |
334 | is_deeply ( |
335 | [map { $_->owner->name } ($rs->all) ], |
336 | \@owner_names, |
337 | "$test_type: Prefetched rows were properly ordered" |
338 | ); |
339 | |
340 | my $limited_rs = $rs->search ({}, {rows => 6, offset => 2, unsafe_subselect_ok => 1}); |
341 | is ($limited_rs->count, 6, "$test_type: Correct count of limited right-sorted joined resultset"); |
342 | is ($limited_rs->count_rs->next, 6, "$test_type: Correct count_rs of limited right-sorted joined resultset"); |
343 | |
344 | my $queries; |
345 | my $orig_debug = $schema->storage->debug; |
346 | $schema->storage->debugcb(sub { $queries++; }); |
347 | $schema->storage->debug(1); |
348 | |
349 | is_deeply ( |
350 | [map { $_->owner->name } ($limited_rs->all) ], |
351 | [@owner_names[2 .. 7]], |
352 | "$test_type: Prefetch-limited rows were properly ordered" |
353 | ); |
354 | is ($queries, 1, "$test_type: Only one query with prefetch"); |
355 | |
356 | $schema->storage->debugcb(undef); |
357 | $schema->storage->debug($orig_debug); |
358 | |
359 | is_deeply ( |
360 | [map { $_->name } ($limited_rs->search_related ('owner')->all) ], |
361 | [@owner_names[2 .. 7]], |
362 | "$test_type: Rows are still properly ordered after search_related", |
363 | ); |
364 | } |
a54bd479 |
365 | |
e56b1c2d |
366 | # try a ->has_many direction with duplicates |
367 | my $owners = $schema->resultset ('Owners')->search ( |
368 | { |
369 | 'books.id' => { '!=', undef }, |
370 | 'me.name' => { '!=', 'somebogusstring' }, |
371 | }, |
372 | { |
373 | prefetch => 'books', |
374 | order_by => { -asc => \['name + ?', [ test => 'xxx' ]] }, # test bindvar propagation |
375 | group_by => [ map { "me.$_" } $schema->source('Owners')->columns ], # the literal order_by requires an explicit group_by |
376 | rows => 3, # 8 results total |
377 | unsafe_subselect_ok => 1, |
378 | }, |
379 | ); |
a54bd479 |
380 | |
e56b1c2d |
381 | my ($sql, @bind) = @${$owners->page(3)->as_query}; |
0e773352 |
382 | is_same_bind ( |
e56b1c2d |
383 | \@bind, |
384 | [ |
fcb7fcbb |
385 | ($dialect eq 'Top' ? [ { dbic_colname => 'test' } => 'xxx' ] : ()), # the extra re-order bind |
386 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' } |
387 | => 'somebogusstring' ], |
388 | [ { dbic_colname => 'test' } |
389 | => 'xxx' ], |
390 | ($dialect ne 'Top' ? ( [ $OFFSET => 7 ], [ $TOTAL => 9 ] ) : ()), # parameterised RNO |
391 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'me.name' } |
392 | => 'somebogusstring' ], |
393 | [ { dbic_colname => 'test' } |
394 | => 'xxx' ], |
e56b1c2d |
395 | ], |
a54bd479 |
396 | ); |
fb7cd45f |
397 | |
e56b1c2d |
398 | is ($owners->page(1)->all, 3, "$test_type: has_many prefetch returns correct number of rows"); |
399 | is ($owners->page(1)->count, 3, "$test_type: has-many prefetch returns correct count"); |
a54bd479 |
400 | |
e56b1c2d |
401 | is ($owners->page(3)->count, 2, "$test_type: has-many prefetch returns correct count"); |
402 | TODO: { |
403 | local $TODO = "Top-limit does not work when your limit ends up past the resultset" |
404 | if $dialect eq 'Top'; |
405 | is ($owners->page(3)->all, 2, "$test_type: has_many prefetch returns correct number of rows"); |
406 | is ($owners->page(3)->count_rs->next, 2, "$test_type: has-many prefetch returns correct count_rs"); |
a54bd479 |
407 | } |
a54bd479 |
408 | |
a54bd479 |
409 | |
e56b1c2d |
410 | # try a ->belongs_to direction (no select collapse, group_by should work) |
411 | my $books = $schema->resultset ('BooksInLibrary')->search ( |
412 | { |
413 | 'owner.name' => [qw/wiggle woggle/], |
414 | }, |
415 | { |
416 | distinct => 1, |
417 | having => \['1 = ?', [ test => 1 ] ], #test having propagation |
418 | prefetch => 'owner', |
419 | rows => 2, # 3 results total |
420 | order_by => { -desc => 'me.owner' }, |
421 | unsafe_subselect_ok => 1, |
422 | }, |
423 | ); |
6de07ea3 |
424 | |
e56b1c2d |
425 | ($sql, @bind) = @${$books->page(3)->as_query}; |
0e773352 |
426 | is_same_bind ( |
e56b1c2d |
427 | \@bind, |
428 | [ |
429 | # inner |
0e773352 |
430 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' } |
431 | => 'wiggle' ], |
432 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' } |
433 | => 'woggle' ], |
434 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } |
435 | => 'Library' ], |
436 | [ { dbic_colname => 'test' } |
437 | => '1' ], |
438 | |
fcb7fcbb |
439 | # rno(?) |
440 | $dialect ne 'Top' ? ( [ $OFFSET => 5 ], [ $TOTAL => 6 ] ) : (), |
e56b1c2d |
441 | # outer |
0e773352 |
442 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' } |
443 | => 'wiggle' ], |
444 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'owner.name' } |
445 | => 'woggle' ], |
446 | [ { sqlt_datatype => 'varchar', sqlt_size => 100, dbic_colname => 'source' } |
447 | => 'Library' ], |
e56b1c2d |
448 | ], |
449 | ); |
4bb438ca |
450 | |
e56b1c2d |
451 | is ($books->page(1)->all, 2, "$test_type: Prefetched grouped search returns correct number of rows"); |
452 | is ($books->page(1)->count, 2, "$test_type: Prefetched grouped search returns correct count"); |
a54bd479 |
453 | |
e56b1c2d |
454 | is ($books->page(2)->count, 1, "$test_type: Prefetched grouped search returns correct count"); |
455 | TODO: { |
456 | local $TODO = "Top-limit does not work when your limit ends up past the resultset" |
457 | if $dialect eq 'Top'; |
458 | is ($books->page(2)->all, 1, "$test_type: Prefetched grouped search returns correct number of rows"); |
459 | is ($books->page(2)->count_rs->next, 1, "$test_type: Prefetched grouped search returns correct count_rs"); |
460 | } |
461 | } |
a54bd479 |
462 | } |
6de07ea3 |
463 | |
464 | |
a54bd479 |
465 | # test GUID columns |
e56b1c2d |
466 | { |
467 | $schema->storage->dbh_do (sub { |
468 | my ($storage, $dbh) = @_; |
469 | eval { $dbh->do("DROP TABLE artist_guid") }; |
470 | $dbh->do(<<'SQL'); |
b1bdb76d |
471 | CREATE TABLE artist_guid ( |
a54bd479 |
472 | artistid UNIQUEIDENTIFIER NOT NULL, |
473 | name VARCHAR(100), |
474 | rank INT NOT NULL DEFAULT '13', |
475 | charfield CHAR(10) NULL, |
476 | a_guid UNIQUEIDENTIFIER, |
477 | primary key(artistid) |
478 | ) |
479 | SQL |
e56b1c2d |
480 | }); |
8ff60918 |
481 | |
e56b1c2d |
482 | # start disconnected to make sure insert works on an un-reblessed storage |
483 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); |
8ff60918 |
484 | |
e56b1c2d |
485 | my $row; |
486 | lives_ok { |
487 | $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' }) |
488 | } 'created a row with a GUID'; |
8ff60918 |
489 | |
e56b1c2d |
490 | ok( |
491 | eval { $row->artistid }, |
492 | 'row has GUID PK col populated', |
493 | ); |
494 | diag $@ if $@; |
8ff60918 |
495 | |
e56b1c2d |
496 | ok( |
497 | eval { $row->a_guid }, |
498 | 'row has a GUID col with auto_nextval populated', |
499 | ); |
500 | diag $@ if $@; |
8ff60918 |
501 | |
e56b1c2d |
502 | my $row_from_db = $schema->resultset('ArtistGUID') |
503 | ->search({ name => 'mtfnpy' })->first; |
f0bd60fc |
504 | |
e56b1c2d |
505 | is $row_from_db->artistid, $row->artistid, |
506 | 'PK GUID round trip'; |
b9a2c3a5 |
507 | |
e56b1c2d |
508 | is $row_from_db->a_guid, $row->a_guid, |
509 | 'NON-PK GUID round trip'; |
510 | } |
02d133f0 |
511 | |
a54bd479 |
512 | # test MONEY type |
e56b1c2d |
513 | { |
514 | $schema->storage->dbh_do (sub { |
515 | my ($storage, $dbh) = @_; |
516 | eval { $dbh->do("DROP TABLE money_test") }; |
517 | $dbh->do(<<'SQL'); |
a54bd479 |
518 | CREATE TABLE money_test ( |
519 | id INT IDENTITY PRIMARY KEY, |
520 | amount MONEY NULL |
521 | ) |
522 | SQL |
e56b1c2d |
523 | }); |
9010bab8 |
524 | |
e56b1c2d |
525 | my $rs = $schema->resultset('Money'); |
526 | my $row; |
56d2561e |
527 | |
e56b1c2d |
528 | lives_ok { |
529 | $row = $rs->create({ amount => 100 }); |
530 | } 'inserted a money value'; |
6bc666a5 |
531 | |
e56b1c2d |
532 | cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip'; |
b9a2c3a5 |
533 | |
e56b1c2d |
534 | lives_ok { |
535 | $row->update({ amount => 200 }); |
536 | } 'updated a money value'; |
fc85215b |
537 | |
e56b1c2d |
538 | cmp_ok $rs->find($row->id)->amount, '==', 200, |
539 | 'updated money value round-trip'; |
b1e1d073 |
540 | |
e56b1c2d |
541 | lives_ok { |
542 | $row->update({ amount => undef }); |
543 | } 'updated a money value to NULL'; |
b1e1d073 |
544 | |
e56b1c2d |
545 | is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip'; |
546 | } |
547 | } |
384b8bce |
548 | } |
c1cac633 |
549 | |
afcfff01 |
550 | done_testing; |
551 | |
c1cac633 |
552 | # clean up our mess |
553 | END { |
ca791b95 |
554 | if (my $dbh = eval { $schema->storage->_dbh }) { |
555 | eval { $dbh->do("DROP TABLE $_") } |
b1bdb76d |
556 | for qw/artist artist_guid money_test books owners/; |
ca791b95 |
557 | } |
c1cac633 |
558 | } |
fc85215b |
559 | # vim:sw=2 sts=2 |