RT50874
[dbsrgits/DBIx-Class-Historic.git] / t / 746sybase.t
1 use strict;
2 use warnings;  
3 no warnings 'uninitialized';
4
5 use Test::More;
6 use Test::Exception;
7 use lib qw(t/lib);
8 use DBICTest;
9
10 require DBIx::Class::Storage::DBI::Sybase;
11 require DBIx::Class::Storage::DBI::Sybase::NoBindVars;
12
13 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
14
15 my $TESTS = 63 + 2;
16
17 if (not ($dsn && $user)) {
18   plan skip_all =>
19     'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test' .
20     "\nWarning: This test drops and creates the tables " .
21     "'artist', 'money_test' and 'bindtype_test'";
22 } else {
23   plan tests => $TESTS*2 + 1;
24 }
25
26 my @storage_types = (
27   'DBI::Sybase',
28   'DBI::Sybase::NoBindVars',
29 );
30 my $schema;
31 my $storage_idx = -1;
32
33 sub get_schema {
34   DBICTest::Schema->connect($dsn, $user, $pass, {
35     on_connect_call => [
36       [ blob_setup => log_on_update => 1 ], # this is a safer option
37     ],
38   });
39 }
40
41 my $ping_count = 0;
42 {
43   my $ping = DBIx::Class::Storage::DBI::Sybase->can('_ping');
44   *DBIx::Class::Storage::DBI::Sybase::_ping = sub {
45     $ping_count++;
46     goto $ping;
47   };
48 }
49
50 for my $storage_type (@storage_types) {
51   $storage_idx++;
52
53   unless ($storage_type eq 'DBI::Sybase') { # autodetect
54     DBICTest::Schema->storage_type("::$storage_type");
55   }
56
57   $schema = get_schema();
58
59   $schema->storage->ensure_connected;
60
61   if ($storage_idx == 0 &&
62       $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::NoBindVars')) {
63 # no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS)
64       my $tb = Test::More->builder;
65       $tb->skip('no placeholders') for 1..$TESTS;
66       next;
67   }
68
69   isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" );
70
71   $schema->storage->_dbh->disconnect;
72   lives_ok (sub { $schema->storage->dbh }, 'reconnect works');
73
74   $schema->storage->dbh_do (sub {
75       my ($storage, $dbh) = @_;
76       eval { $dbh->do("DROP TABLE artist") };
77       $dbh->do(<<'SQL');
78 CREATE TABLE artist (
79    artistid INT IDENTITY PRIMARY KEY,
80    name VARCHAR(100),
81    rank INT DEFAULT 13 NOT NULL,
82    charfield CHAR(10) NULL
83 )
84 SQL
85   });
86
87   my %seen_id;
88
89 # so we start unconnected
90   $schema->storage->disconnect;
91
92 # test primary key handling
93   my $new = $schema->resultset('Artist')->create({ name => 'foo' });
94   ok($new->artistid > 0, "Auto-PK worked");
95
96   $seen_id{$new->artistid}++;
97
98 # check redispatch to storage-specific insert when auto-detected storage
99   if ($storage_type eq 'DBI::Sybase') {
100     DBICTest::Schema->storage_type('::DBI');
101     $schema = get_schema();
102   }
103
104   $new = $schema->resultset('Artist')->create({ name => 'Artist 1' });
105   is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' );
106   $seen_id{$new->artistid}++;
107
108 # inserts happen in a txn, so we make sure it still works inside a txn too
109   $schema->txn_begin;
110
111   for (2..6) {
112     $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
113     is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
114     $seen_id{$new->artistid}++;
115   }
116
117   $schema->txn_commit;
118
119 # test simple count
120   is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok');
121
122 # test LIMIT support
123   my $it = $schema->resultset('Artist')->search({
124     artistid => { '>' => 0 }
125   }, {
126     rows => 3,
127     order_by => 'artistid',
128   });
129
130   is( $it->count, 3, "LIMIT count ok" );
131
132   is( $it->next->name, "foo", "iterator->next ok" );
133   $it->next;
134   is( $it->next->name, "Artist 2", "iterator->next ok" );
135   is( $it->next, undef, "next past end of resultset ok" );
136
137 # now try with offset
138   $it = $schema->resultset('Artist')->search({}, {
139     rows => 3,
140     offset => 3,
141     order_by => 'artistid',
142   });
143
144   is( $it->count, 3, "LIMIT with offset count ok" );
145
146   is( $it->next->name, "Artist 3", "iterator->next ok" );
147   $it->next;
148   is( $it->next->name, "Artist 5", "iterator->next ok" );
149   is( $it->next, undef, "next past end of resultset ok" );
150
151 # now try a grouped count
152   $schema->resultset('Artist')->create({ name => 'Artist 6' })
153     for (1..6);
154
155   $it = $schema->resultset('Artist')->search({}, {
156     group_by => 'name'
157   });
158
159   is( $it->count, 7, 'COUNT of GROUP_BY ok' );
160
161 # do an IDENTITY_INSERT
162   {
163     no warnings 'redefine';
164
165     my @debug_out;
166     local $schema->storage->{debug} = 1;
167     local $schema->storage->debugobj->{callback} = sub {
168       push @debug_out, $_[1];
169     };
170
171     my $txn_used = 0;
172     my $txn_commit = \&DBIx::Class::Storage::DBI::txn_commit;
173     local *DBIx::Class::Storage::DBI::txn_commit = sub {
174       $txn_used = 1;
175       goto &$txn_commit;
176     };
177
178     $schema->resultset('Artist')
179       ->create({ artistid => 999, name => 'mtfnpy' });
180
181     ok((grep /IDENTITY_INSERT/i, @debug_out), 'IDENTITY_INSERT used');
182
183     SKIP: {
184       skip 'not testing lack of txn on IDENTITY_INSERT with NoBindVars', 1
185         if $storage_type =~ /NoBindVars/i;
186
187       is $txn_used, 0, 'no txn on insert with IDENTITY_INSERT';
188     }
189   }
190
191 # do an IDENTITY_UPDATE
192   {
193     my @debug_out;
194     local $schema->storage->{debug} = 1;
195     local $schema->storage->debugobj->{callback} = sub {
196       push @debug_out, $_[1];
197     };
198
199     lives_and {
200       $schema->resultset('Artist')
201         ->find(999)->update({ artistid => 555 });
202       ok((grep /IDENTITY_UPDATE/i, @debug_out));
203     } 'IDENTITY_UPDATE used';
204     $ping_count-- if $@;
205   }
206
207   my $bulk_rs = $schema->resultset('Artist')->search({
208     name => { -like => 'bulk artist %' }
209   });
210
211 # test insert_bulk using populate.
212   SKIP: {
213     skip 'insert_bulk not supported', 4
214       unless $storage_type !~ /NoBindVars/i;
215
216     lives_ok {
217       $schema->resultset('Artist')->populate([
218         {
219           name => 'bulk artist 1',
220           charfield => 'foo',
221         },
222         {
223           name => 'bulk artist 2',
224           charfield => 'foo',
225         },
226         {
227           name => 'bulk artist 3',
228           charfield => 'foo',
229         },
230       ]);
231     } 'insert_bulk via populate';
232
233     is $bulk_rs->count, 3, 'correct number inserted via insert_bulk';
234
235     is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
236       'column set correctly via insert_bulk');
237
238     my %bulk_ids;
239     @bulk_ids{map $_->artistid, $bulk_rs->all} = ();
240
241     is ((scalar keys %bulk_ids), 3,
242       'identities generated correctly in insert_bulk');
243
244     $bulk_rs->delete;
245   }
246
247 # make sure insert_bulk works a second time on the same connection
248   SKIP: {
249     skip 'insert_bulk not supported', 3
250       unless $storage_type !~ /NoBindVars/i;
251
252     lives_ok {
253       $schema->resultset('Artist')->populate([
254         {
255           name => 'bulk artist 1',
256           charfield => 'bar',
257         },
258         {
259           name => 'bulk artist 2',
260           charfield => 'bar',
261         },
262         {
263           name => 'bulk artist 3',
264           charfield => 'bar',
265         },
266       ]);
267     } 'insert_bulk via populate called a second time';
268
269     is $bulk_rs->count, 3,
270       'correct number inserted via insert_bulk';
271
272     is ((grep $_->charfield eq 'bar', $bulk_rs->all), 3,
273       'column set correctly via insert_bulk');
274
275     $bulk_rs->delete;
276   }
277
278 # test invalid insert_bulk (missing required column)
279 #
280 # There should be a rollback, reconnect and the next valid insert_bulk should
281 # succeed.
282   throws_ok {
283     $schema->resultset('Artist')->populate([
284       {
285         charfield => 'foo',
286       }
287     ]);
288   } qr/no value or default|does not allow null|placeholders/i,
289 # The second pattern is the error from fallback to regular array insert on
290 # incompatible charset.
291 # The third is for ::NoBindVars with no syb_has_blk.
292   'insert_bulk with missing required column throws error';
293
294 # now test insert_bulk with IDENTITY_INSERT
295   SKIP: {
296     skip 'insert_bulk not supported', 3
297       unless $storage_type !~ /NoBindVars/i;
298
299     lives_ok {
300       $schema->resultset('Artist')->populate([
301         {
302           artistid => 2001,
303           name => 'bulk artist 1',
304           charfield => 'foo',
305         },
306         {
307           artistid => 2002,
308           name => 'bulk artist 2',
309           charfield => 'foo',
310         },
311         {
312           artistid => 2003,
313           name => 'bulk artist 3',
314           charfield => 'foo',
315         },
316       ]);
317     } 'insert_bulk with IDENTITY_INSERT via populate';
318
319     is $bulk_rs->count, 3,
320       'correct number inserted via insert_bulk with IDENTITY_INSERT';
321
322     is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3,
323       'column set correctly via insert_bulk with IDENTITY_INSERT');
324
325     $bulk_rs->delete;
326   }
327
328 # test correlated subquery
329   my $subq = $schema->resultset('Artist')->search({ artistid => { '>' => 3 } })
330     ->get_column('artistid')
331     ->as_query;
332   my $subq_rs = $schema->resultset('Artist')->search({
333     artistid => { -in => $subq }
334   });
335   is $subq_rs->count, 11, 'correlated subquery';
336
337 # mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t
338   SKIP: {
339     skip 'TEXT/IMAGE support does not work with FreeTDS', 22
340       if $schema->storage->using_freetds;
341
342     my $dbh = $schema->storage->_dbh;
343     {
344       local $SIG{__WARN__} = sub {};
345       eval { $dbh->do('DROP TABLE bindtype_test') };
346
347       $dbh->do(qq[
348         CREATE TABLE bindtype_test 
349         (
350           id    INT   IDENTITY PRIMARY KEY,
351           bytea IMAGE NULL,
352           blob  IMAGE NULL,
353           clob  TEXT  NULL
354         )
355       ],{ RaiseError => 1, PrintError => 0 });
356     }
357
358     my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
359     $binstr{'large'} = $binstr{'small'} x 1024;
360
361     my $maxloblen = length $binstr{'large'};
362     
363     if (not $schema->storage->using_freetds) {
364       $dbh->{'LongReadLen'} = $maxloblen * 2;
365     } else {
366       $dbh->do("set textsize ".($maxloblen * 2));
367     }
368
369     my $rs = $schema->resultset('BindType');
370     my $last_id;
371
372     foreach my $type (qw(blob clob)) {
373       foreach my $size (qw(small large)) {
374         no warnings 'uninitialized';
375
376         my $created;
377         lives_ok {
378           $created = $rs->create( { $type => $binstr{$size} } )
379         } "inserted $size $type without dying";
380
381         $last_id = $created->id if $created;
382
383         lives_and {
384           ok($rs->find($last_id)->$type eq $binstr{$size})
385         } "verified inserted $size $type";
386       }
387     }
388
389     $rs->delete;
390
391     # blob insert with explicit PK
392     # also a good opportunity to test IDENTITY_INSERT
393     lives_ok {
394       $rs->create( { id => 1, blob => $binstr{large} } )
395     } 'inserted large blob without dying with manual PK';
396
397     lives_and {
398       ok($rs->find(1)->blob eq $binstr{large})
399     } 'verified inserted large blob with manual PK';
400
401     # try a blob update
402     my $new_str = $binstr{large} . 'mtfnpy';
403
404     # check redispatch to storage-specific update when auto-detected storage
405     if ($storage_type eq 'DBI::Sybase') {
406       DBICTest::Schema->storage_type('::DBI');
407       $schema = get_schema();
408     }
409
410     lives_ok {
411       $rs->search({ id => 1 })->update({ blob => $new_str })
412     } 'updated blob successfully';
413
414     lives_and {
415       ok($rs->find(1)->blob eq $new_str)
416     } 'verified updated blob';
417
418     # try a blob update with IDENTITY_UPDATE
419     lives_and {
420       $new_str = $binstr{large} . 'hlagh';
421       $rs->find(1)->update({ id => 999, blob => $new_str });
422       ok($rs->find(999)->blob eq $new_str);
423     } 'verified updated blob with IDENTITY_UPDATE';
424
425     ## try multi-row blob update
426     # first insert some blobs
427     $new_str = $binstr{large} . 'foo';
428     lives_and {
429       $rs->delete;
430       $rs->create({ blob => $binstr{large} }) for (1..2);
431       $rs->update({ blob => $new_str });
432       is((grep $_->blob eq $new_str, $rs->all), 2);
433     } 'multi-row blob update';
434
435     $rs->delete;
436
437     # now try insert_bulk with blobs and only blobs
438     $new_str = $binstr{large} . 'bar';
439     lives_ok {
440       $rs->populate([
441         {
442           bytea => 1,
443           blob => $binstr{large},
444           clob => $new_str,
445         },
446         {
447           bytea => 1,
448           blob => $binstr{large},
449           clob => $new_str,
450         },
451       ]);
452     } 'insert_bulk with blobs does not die';
453
454     is((grep $_->blob eq $binstr{large}, $rs->all), 2,
455       'IMAGE column set correctly via insert_bulk');
456
457     is((grep $_->clob eq $new_str, $rs->all), 2,
458       'TEXT column set correctly via insert_bulk');
459
460     # now try insert_bulk with blobs and a non-blob which also happens to be an
461     # identity column
462     SKIP: {
463       skip 'no insert_bulk without placeholders', 4
464         if $storage_type =~ /NoBindVars/i;
465
466       $rs->delete;
467       $new_str = $binstr{large} . 'bar';
468       lives_ok {
469         $rs->populate([
470           {
471             id => 1,
472             bytea => 1,
473             blob => $binstr{large},
474             clob => $new_str,
475           },
476           {
477             id => 2,
478             bytea => 1,
479             blob => $binstr{large},
480             clob => $new_str,
481           },
482         ]);
483       } 'insert_bulk with blobs and explicit identity does NOT die';
484
485       is((grep $_->blob eq $binstr{large}, $rs->all), 2,
486         'IMAGE column set correctly via insert_bulk with identity');
487
488       is((grep $_->clob eq $new_str, $rs->all), 2,
489         'TEXT column set correctly via insert_bulk with identity');
490
491       is_deeply [ map $_->id, $rs->all ], [ 1,2 ],
492         'explicit identities set correctly via insert_bulk with blobs';
493     }
494
495     lives_and {
496       $rs->delete;
497       $rs->create({ blob => $binstr{large} }) for (1..2);
498       $rs->update({ blob => undef });
499       is((grep !defined($_->blob), $rs->all), 2);
500     } 'blob update to NULL';
501   }
502
503 # test MONEY column support (and some other misc. stuff)
504   $schema->storage->dbh_do (sub {
505       my ($storage, $dbh) = @_;
506       eval { $dbh->do("DROP TABLE money_test") };
507       $dbh->do(<<'SQL');
508 CREATE TABLE money_test (
509    id INT IDENTITY PRIMARY KEY,
510    amount MONEY DEFAULT $999.99 NULL
511 )
512 SQL
513   });
514
515   my $rs = $schema->resultset('Money');
516
517 # test insert with defaults
518   lives_and {
519     $rs->create({});
520     is((grep $_->amount == 999.99, $rs->all), 1);
521   } 'insert with all defaults works';
522   $rs->delete;
523
524 # test insert transaction when there's an active cursor
525   {
526     my $artist_rs = $schema->resultset('Artist');
527     $artist_rs->first;
528     lives_ok {
529       my $row = $schema->resultset('Money')->create({ amount => 100 });
530       $row->delete;
531     } 'inserted a row with an active cursor';
532     $ping_count-- if $@; # dbh_do calls ->connected
533   }
534
535 # test insert in an outer transaction when there's an active cursor
536   TODO: {
537     local $TODO = 'this should work once we have eager cursors';
538
539 # clear state, or we get a deadlock on $row->delete
540 # XXX figure out why this happens
541     $schema->storage->disconnect;
542
543     lives_ok {
544       $schema->txn_do(sub {
545         my $artist_rs = $schema->resultset('Artist');
546         $artist_rs->first;
547         my $row = $schema->resultset('Money')->create({ amount => 100 });
548         $row->delete;
549       });
550     } 'inserted a row with an active cursor in outer txn';
551     $ping_count-- if $@; # dbh_do calls ->connected
552   }
553
554 # Now test money values.
555   my $row;
556   lives_ok {
557     $row = $rs->create({ amount => 100 });
558   } 'inserted a money value';
559
560   is eval { $rs->find($row->id)->amount }, 100, 'money value round-trip';
561
562   lives_ok {
563     $row->update({ amount => 200 });
564   } 'updated a money value';
565
566   is eval { $rs->find($row->id)->amount },
567     200, 'updated money value round-trip';
568
569   lives_ok {
570     $row->update({ amount => undef });
571   } 'updated a money value to NULL';
572
573   my $null_amount = eval { $rs->find($row->id)->amount };
574   ok(
575     (($null_amount == undef) && (not $@)),
576     'updated money value to NULL round-trip'
577   );
578   diag $@ if $@;
579 }
580
581 is $ping_count, 0, 'no pings';
582
583 # clean up our mess
584 END {
585   if (my $dbh = eval { $schema->storage->_dbh }) {
586     eval { $dbh->do("DROP TABLE $_") }
587       for qw/artist bindtype_test money_test/;
588   }
589 }