fix rounding issues in mssql money tests
[dbsrgits/DBIx-Class-Historic.git] / t / 746mssql.t
CommitLineData
c1cac633 1use strict;
b9a2c3a5 2use warnings;
c1cac633 3
4use Test::More;
893403c8 5use Test::Exception;
c1cac633 6use lib qw(t/lib);
7use DBICTest;
b2d16f1f 8use DBIC::SqlMakerTest;
c1cac633 9
10my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/};
11
12plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
13 unless ($dsn && $user);
14
ca791b95 15plan tests => 39;
c1cac633 16
ca791b95 17DBICTest::Schema->load_classes('ArtistGUID');
42e5b103 18my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
c1cac633 19
8c0104fe 20{
21 no warnings 'redefine';
22 my $connect_count = 0;
23 my $orig_connect = \&DBI::connect;
24 local *DBI::connect = sub { $connect_count++; goto &$orig_connect };
25
26 $schema->storage->ensure_connected;
27
28 is( $connect_count, 1, 'only one connection made');
29}
9b3e916d 30
c1cac633 31isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
32
c5f77f6c 33$schema->storage->dbh_do (sub {
34 my ($storage, $dbh) = @_;
35 eval { $dbh->do("DROP TABLE artist") };
36 $dbh->do(<<'SQL');
c1cac633 37CREATE TABLE artist (
38 artistid INT IDENTITY NOT NULL,
a0dd8679 39 name VARCHAR(100),
39da2a2b 40 rank INT NOT NULL DEFAULT '13',
2eebd801 41 charfield CHAR(10) NULL,
c1cac633 42 primary key(artistid)
43)
c5f77f6c 44SQL
c5f77f6c 45});
46
c1cac633 47my %seen_id;
48
7b1b2582 49my @opts = (
50 { on_connect_call => 'use_dynamic_cursors' },
51 {},
52);
53my $new;
2eebd801 54
7b1b2582 55# test Auto-PK with different options
56for my $opts (@opts) {
41dd5d30 57 SKIP: {
58 $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
7b1b2582 59
41dd5d30 60 eval {
61 $schema->storage->ensure_connected
62 };
63 if ($@ =~ /dynamic cursors/) {
64 skip
65'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'.
66' FreeTDS', 1;
67 }
7b1b2582 68
41dd5d30 69 $schema->resultset('Artist')->search({ name => 'foo' })->delete;
70
71 $new = $schema->resultset('Artist')->create({ name => 'foo' });
72
73 ok($new->artistid > 0, "Auto-PK worked");
74 }
7b1b2582 75}
c1cac633 76
77$seen_id{$new->artistid}++;
78
79# test LIMIT support
80for (1..6) {
81 $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
82 is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
83 $seen_id{$new->artistid}++;
84}
85
86my $it = $schema->resultset('Artist')->search( {}, {
87 rows => 3,
88 order_by => 'artistid',
89});
90
91is( $it->count, 3, "LIMIT count ok" );
92is( $it->next->name, "foo", "iterator->next ok" );
93$it->next;
94is( $it->next->name, "Artist 2", "iterator->next ok" );
95is( $it->next, undef, "next past end of resultset ok" );
96
ca791b95 97# test GUID columns
98
99$schema->storage->dbh_do (sub {
100 my ($storage, $dbh) = @_;
101 eval { $dbh->do("DROP TABLE artist") };
102 $dbh->do(<<'SQL');
103CREATE TABLE artist (
104 artistid UNIQUEIDENTIFIER NOT NULL,
105 name VARCHAR(100),
106 rank INT NOT NULL DEFAULT '13',
107 charfield CHAR(10) NULL,
108 a_guid UNIQUEIDENTIFIER,
109 primary key(artistid)
110)
111SQL
112});
113
e34bae3a 114# start disconnected to make sure insert works on an un-reblessed storage
115$schema = DBICTest::Schema->connect($dsn, $user, $pass);
116
ca791b95 117my $row;
118lives_ok {
119 $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' })
120} 'created a row with a GUID';
121
122ok(
123 eval { $row->artistid },
124 'row has GUID PK col populated',
125);
126diag $@ if $@;
127
128ok(
129 eval { $row->a_guid },
130 'row has a GUID col with auto_nextval populated',
131);
132diag $@ if $@;
133
134my $row_from_db = $schema->resultset('ArtistGUID')
135 ->search({ name => 'mtfnpy' })->first;
136
137is $row_from_db->artistid, $row->artistid,
138 'PK GUID round trip';
139
140is $row_from_db->a_guid, $row->a_guid,
141 'NON-PK GUID round trip';
142
818ec409 143# test MONEY type
144$schema->storage->dbh_do (sub {
145 my ($storage, $dbh) = @_;
146 eval { $dbh->do("DROP TABLE money_test") };
147 $dbh->do(<<'SQL');
148
149CREATE TABLE money_test (
150 id INT IDENTITY PRIMARY KEY,
5064f5c3 151 amount MONEY NULL
818ec409 152)
153
154SQL
155
156});
157
158my $rs = $schema->resultset('Money');
159
818ec409 160lives_ok {
d68f21ee 161 $row = $rs->create({ amount => 100 });
818ec409 162} 'inserted a money value';
163
c8365716 164is int($rs->find($row->id)->amount), 100, 'money value round-trip';
818ec409 165
d68f21ee 166lives_ok {
167 $row->update({ amount => 200 });
168} 'updated a money value';
169
c8365716 170is int($rs->find($row->id)->amount), 200, 'updated money value round-trip';
d68f21ee 171
f6b185e1 172lives_ok {
173 $row->update({ amount => undef });
174} 'updated a money value to NULL';
175
176is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
177
b9a2c3a5 178$schema->storage->dbh_do (sub {
179 my ($storage, $dbh) = @_;
180 eval { $dbh->do("DROP TABLE Owners") };
181 eval { $dbh->do("DROP TABLE Books") };
182 $dbh->do(<<'SQL');
b9a2c3a5 183CREATE TABLE Books (
184 id INT IDENTITY (1, 1) NOT NULL,
185 source VARCHAR(100),
186 owner INT,
187 title VARCHAR(10),
188 price INT NULL
189)
190
191CREATE TABLE Owners (
192 id INT IDENTITY (1, 1) NOT NULL,
42e5b103 193 name VARCHAR(100),
b9a2c3a5 194)
b9a2c3a5 195SQL
196
197});
893403c8 198
199lives_ok ( sub {
200 $schema->populate ('Owners', [
201 [qw/id name /],
202 [qw/1 wiggle/],
203 [qw/2 woggle/],
204 [qw/3 boggle/],
205 [qw/4 fREW/],
206 [qw/5 fRIOUX/],
207 [qw/6 fROOH/],
208 [qw/7 fRUE/],
209 [qw/8 fISMBoC/],
210 [qw/9 station/],
211 [qw/10 mirror/],
212 [qw/11 dimly/],
213 [qw/12 face_to_face/],
214 [qw/13 icarus/],
215 [qw/14 dream/],
216 [qw/15 dyrstyggyr/],
217 ]);
218}, 'populate with PKs supplied ok' );
219
220lives_ok ( sub {
221 $schema->populate ('BooksInLibrary', [
222 [qw/source owner title /],
223 [qw/Library 1 secrets0/],
224 [qw/Library 1 secrets1/],
225 [qw/Eatery 1 secrets2/],
226 [qw/Library 2 secrets3/],
227 [qw/Library 3 secrets4/],
228 [qw/Eatery 3 secrets5/],
229 [qw/Library 4 secrets6/],
230 [qw/Library 5 secrets7/],
231 [qw/Eatery 5 secrets8/],
232 [qw/Library 6 secrets9/],
233 [qw/Library 7 secrets10/],
234 [qw/Eatery 7 secrets11/],
235 [qw/Library 8 secrets12/],
236 ]);
237}, 'populate without PKs supplied ok' );
b9a2c3a5 238
239#
02d133f0 240# try a prefetch on tables with identically named columns
b9a2c3a5 241#
242
02d133f0 243# set quote char - make sure things work while quoted
244$schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
245$schema->storage->_sql_maker->{name_sep} = '.';
246
b9a2c3a5 247{
893403c8 248 # try a ->has_many direction
fc85215b 249 my $owners = $schema->resultset ('Owners')->search ({
250 'books.id' => { '!=', undef }
251 }, {
252 prefetch => 'books',
ff1ef65b 253 order_by => 'name',
56d2561e 254 rows => 3, # 8 results total
fc85215b 255 });
256
56d2561e 257 is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
258 is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
259
618a0fe3 260 TODO: {
261 local $TODO = 'limit past end of resultset problem';
56d2561e 262 is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
263 is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
64c7c000 264 is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
265
e2751d0b 266 # make sure count does not become overly complex
64c7c000 267 is_same_sql_bind (
268 $owners->page(3)->count_rs->as_query,
269 '(
270 SELECT COUNT( * )
271 FROM (
02d133f0 272 SELECT TOP 3 [me].[id]
273 FROM [owners] [me]
274 LEFT JOIN [books] [books] ON [books].[owner] = [me].[id]
275 WHERE ( [books].[id] IS NOT NULL )
276 GROUP BY [me].[id]
277 ORDER BY [me].[id] DESC
278 ) [count_subq]
64c7c000 279 )',
280 [],
281 );
618a0fe3 282 }
b9a2c3a5 283
42e5b103 284 # try a ->belongs_to direction (no select collapse, group_by should work)
fc85215b 285 my $books = $schema->resultset ('BooksInLibrary')->search ({
56d2561e 286 'owner.name' => [qw/wiggle woggle/],
fc85215b 287 }, {
fc85215b 288 distinct => 1,
42e5b103 289 prefetch => 'owner',
56d2561e 290 rows => 2, # 3 results total
ac93965c 291 order_by => { -desc => 'owner' },
292 # there is no sane way to order by the right side of a grouped prefetch currently :(
293 #order_by => { -desc => 'owner.name' },
fc85215b 294 });
295
b1e1d073 296
56d2561e 297 is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
298 is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
b1e1d073 299
618a0fe3 300 TODO: {
301 local $TODO = 'limit past end of resultset problem';
56d2561e 302 is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
303 is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
64c7c000 304 is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
305
e2751d0b 306 # make sure count does not become overly complex (FIXME - the distinct-induced group_by is incorrect)
64c7c000 307 is_same_sql_bind (
308 $books->page(2)->count_rs->as_query,
309 '(
310 SELECT COUNT( * )
311 FROM (
02d133f0 312 SELECT TOP 2 [me].[id]
313 FROM [books] [me]
314 JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
315 WHERE ( ( ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ? ) )
e2751d0b 316 GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
02d133f0 317 ORDER BY [me].[id] DESC
318 ) [count_subq]
64c7c000 319 )',
320 [
321 [ 'owner.name' => 'wiggle' ],
322 [ 'owner.name' => 'woggle' ],
323 [ 'source' => 'Library' ],
324 ],
325 );
618a0fe3 326 }
b2d16f1f 327
b9a2c3a5 328}
c1cac633 329
330# clean up our mess
331END {
ca791b95 332 if (my $dbh = eval { $schema->storage->_dbh }) {
333 eval { $dbh->do("DROP TABLE $_") }
334 for qw/artist money_test Books Owners/;
335 }
c1cac633 336}
fc85215b 337# vim:sw=2 sts=2