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