This code belogs in Storage::DBI
[dbsrgits/DBIx-Class-Historic.git] / t / 746mssql.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use Test::Exception;
6 use lib qw(t/lib);
7 use DBICTest;
8 use DBIC::SqlMakerTest;
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
15 DBICTest::Schema->load_classes('ArtistGUID');
16 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
17
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 }
28
29 isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server' );
30
31 $schema->storage->dbh_do (sub {
32     my ($storage, $dbh) = @_;
33     eval { $dbh->do("DROP TABLE artist") };
34     $dbh->do(<<'SQL');
35 CREATE TABLE artist (
36    artistid INT IDENTITY NOT NULL,
37    name VARCHAR(100),
38    rank INT NOT NULL DEFAULT '13',
39    charfield CHAR(10) NULL,
40    primary key(artistid)
41 )
42 SQL
43 });
44
45 my %seen_id;
46
47 my @opts = (
48   { on_connect_call => 'use_dynamic_cursors' },
49   {},
50 );
51 my $new;
52
53 # test Auto-PK with different options
54 for my $opts (@opts) {
55   SKIP: {
56     $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts);
57
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     }
66
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   }
73 }
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
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
112 # start disconnected to make sure insert works on an un-reblessed storage
113 $schema = DBICTest::Schema->connect($dsn, $user, $pass);
114
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
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');
146 CREATE TABLE money_test (
147    id INT IDENTITY PRIMARY KEY,
148    amount MONEY NULL
149 )
150 SQL
151 });
152
153 my $rs = $schema->resultset('Money');
154
155 lives_ok {
156   $row = $rs->create({ amount => 100 });
157 } 'inserted a money value';
158
159 cmp_ok $rs->find($row->id)->amount, '==', 100, 'money value round-trip';
160
161 lives_ok {
162   $row->update({ amount => 200 });
163 } 'updated a money value';
164
165 cmp_ok $rs->find($row->id)->amount, '==', 200,
166   'updated money value round-trip';
167
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
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');
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,
189    name VARCHAR(100),
190 )
191 SQL
192
193 });
194
195 lives_ok ( sub {
196   # start a new connection, make sure rebless works
197   my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
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
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
231 lives_ok ( sub {
232   # start a new connection, make sure rebless works
233   my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
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' );
251
252 #
253 # try a prefetch on tables with identically named columns
254 #
255
256 # set quote char - make sure things work while quoted
257 $schema->storage->_sql_maker->{quote_char} = [qw/[ ]/];
258 $schema->storage->_sql_maker->{name_sep} = '.';
259
260 {
261   # try a ->has_many direction
262   my $owners = $schema->resultset ('Owners')->search ({
263       'books.id' => { '!=', undef }
264     }, {
265       prefetch => 'books',
266       order_by => 'name',
267       rows     => 3,  # 8 results total
268     });
269
270   is ($owners->page(1)->all, 3, 'has_many prefetch returns correct number of rows');
271   is ($owners->page(1)->count, 3, 'has-many prefetch returns correct count');
272
273   TODO: {
274     local $TODO = 'limit past end of resultset problem';
275     is ($owners->page(3)->all, 2, 'has_many prefetch returns correct number of rows');
276     is ($owners->page(3)->count, 2, 'has-many prefetch returns correct count');
277     is ($owners->page(3)->count_rs->next, 2, 'has-many prefetch returns correct count_rs');
278
279     # make sure count does not become overly complex
280     is_same_sql_bind (
281       $owners->page(3)->count_rs->as_query,
282       '(
283         SELECT COUNT( * )
284           FROM (
285             SELECT TOP 3 [me].[id]
286               FROM [owners] [me]
287               LEFT JOIN [books] [books] ON [books].[owner] = [me].[id]
288             WHERE ( [books].[id] IS NOT NULL )
289             GROUP BY [me].[id]
290             ORDER BY [me].[id] DESC
291           ) [count_subq]
292       )',
293       [],
294     );
295   }
296
297   # try a ->belongs_to direction (no select collapse, group_by should work)
298   my $books = $schema->resultset ('BooksInLibrary')->search ({
299       'owner.name' => [qw/wiggle woggle/],
300     }, {
301       distinct => 1,
302       prefetch => 'owner',
303       rows     => 2,  # 3 results total
304       order_by => { -desc => 'owner' },
305       # there is no sane way to order by the right side of a grouped prefetch currently :(
306       #order_by => { -desc => 'owner.name' },
307     });
308
309
310   is ($books->page(1)->all, 2, 'Prefetched grouped search returns correct number of rows');
311   is ($books->page(1)->count, 2, 'Prefetched grouped search returns correct count');
312
313   TODO: {
314     local $TODO = 'limit past end of resultset problem';
315     is ($books->page(2)->all, 1, 'Prefetched grouped search returns correct number of rows');
316     is ($books->page(2)->count, 1, 'Prefetched grouped search returns correct count');
317     is ($books->page(2)->count_rs->next, 1, 'Prefetched grouped search returns correct count_rs');
318
319     # make sure count does not become overly complex (FIXME - the distinct-induced group_by is incorrect)
320     is_same_sql_bind (
321       $books->page(2)->count_rs->as_query,
322       '(
323         SELECT COUNT( * )
324           FROM (
325             SELECT TOP 2 [me].[id]
326               FROM [books] [me]
327               JOIN [owners] [owner] ON [owner].[id] = [me].[owner]
328             WHERE ( ( ( [owner].[name] = ? OR [owner].[name] = ? ) AND [source] = ? ) )
329             GROUP BY [me].[id], [me].[source], [me].[owner], [me].[title], [me].[price]
330             ORDER BY [me].[id] DESC
331           ) [count_subq]
332       )',
333       [
334         [ 'owner.name' => 'wiggle' ],
335         [ 'owner.name' => 'woggle' ],
336         [ 'source' => 'Library' ],
337       ],
338     );
339   }
340 }
341
342 done_testing;
343
344 # clean up our mess
345 END {
346   if (my $dbh = eval { $schema->storage->_dbh }) {
347     eval { $dbh->do("DROP TABLE $_") }
348       for qw/artist money_test Books Owners/;
349   }
350 }
351 # vim:sw=2 sts=2