minor changes
[dbsrgits/DBIx-Class-Historic.git] / t / 746sybase.t
CommitLineData
a964a928 1use strict;
2use warnings;
3
4use Test::More;
e0b2344f 5use Test::Exception;
a964a928 6use lib qw(t/lib);
7use DBICTest;
8
9my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
10
7d17f469 11if (not ($dsn && $user)) {
12 plan skip_all =>
13 'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test' .
14 "\nWarning: This test drops and creates the tables " .
15 "'artist' and 'bindtype_test'";
16} else {
64f4e691 17 plan tests => (27 + 2)*2;
7d17f469 18}
a964a928 19
6b1f5ef7 20my @storage_types = (
21 'DBI::Sybase',
22 'DBI::Sybase::NoBindVars',
23);
24my $schema;
25
26for my $storage_type (@storage_types) {
27 $schema = DBICTest::Schema->clone;
28
29 unless ($storage_type eq 'DBI::Sybase') { # autodetect
30 $schema->storage_type("::$storage_type");
31 }
b25da5cf 32 $schema->connection($dsn, $user, $pass, {
33 AutoCommit => 1,
34 on_connect_call => [
b25da5cf 35 [ blob_setup => log_on_update => 1 ], # this is a safer option
36 ],
37 });
a964a928 38
6b1f5ef7 39 $schema->storage->ensure_connected;
64f4e691 40 $schema->storage->_dbh->disconnect;
a964a928 41
6b1f5ef7 42 isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" );
43
64f4e691 44 lives_ok (sub { $schema->storage->dbh }, 'reconnect works');
45
6b1f5ef7 46 $schema->storage->dbh_do (sub {
47 my ($storage, $dbh) = @_;
48 eval { $dbh->do("DROP TABLE artist") };
6b1f5ef7 49 $dbh->do(<<'SQL');
a964a928 50CREATE TABLE artist (
c5ce7cd6 51 artistid INT IDENTITY PRIMARY KEY,
a964a928 52 name VARCHAR(100),
53 rank INT DEFAULT 13 NOT NULL,
c5ce7cd6 54 charfield CHAR(10) NULL
a964a928 55)
c5ce7cd6 56SQL
6b1f5ef7 57 });
a964a928 58
6b1f5ef7 59 my %seen_id;
a964a928 60
6b1f5ef7 61# so we start unconnected
62 $schema->storage->disconnect;
a964a928 63
64# test primary key handling
6b1f5ef7 65 my $new = $schema->resultset('Artist')->create({ name => 'foo' });
66 ok($new->artistid > 0, "Auto-PK worked");
a964a928 67
6b1f5ef7 68 $seen_id{$new->artistid}++;
a964a928 69
6b1f5ef7 70 for (1..6) {
a964a928 71 $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
72 is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
73 $seen_id{$new->artistid}++;
6b1f5ef7 74 }
a964a928 75
aa56ff9a 76# test simple count
77 is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok');
78
79# test LIMIT support
e0b2344f 80 my $it = $schema->resultset('Artist')->search({
81 artistid => { '>' => 0 }
82 }, {
a964a928 83 rows => 3,
84 order_by => 'artistid',
6b1f5ef7 85 });
a964a928 86
b7505130 87 is( $it->count, 3, "LIMIT count ok" );
a964a928 88
6b1f5ef7 89 is( $it->next->name, "foo", "iterator->next ok" );
90 $it->next;
91 is( $it->next->name, "Artist 2", "iterator->next ok" );
92 is( $it->next, undef, "next past end of resultset ok" );
a964a928 93
a0348159 94# now try with offset
95 $it = $schema->resultset('Artist')->search({}, {
96 rows => 3,
97 offset => 3,
98 order_by => 'artistid',
99 });
100
101 is( $it->count, 3, "LIMIT with offset count ok" );
102
103 is( $it->next->name, "Artist 3", "iterator->next ok" );
104 $it->next;
105 is( $it->next->name, "Artist 5", "iterator->next ok" );
106 is( $it->next, undef, "next past end of resultset ok" );
107
92e7a79b 108# now try a grouped count
109 $schema->resultset('Artist')->create({ name => 'Artist 6' })
110 for (1..6);
111
112 $it = $schema->resultset('Artist')->search({}, {
113 group_by => 'name'
114 });
115
116 is( $it->count, 7, 'COUNT of GROUP_BY ok' );
117
6636ad53 118# mostly stole the blob stuff Nniuq wrote for t/73oracle.t
e0b2344f 119 my $dbh = $schema->storage->dbh;
120 {
121 local $SIG{__WARN__} = sub {};
122 eval { $dbh->do('DROP TABLE bindtype_test') };
123
124 $dbh->do(qq[
125 CREATE TABLE bindtype_test
126 (
127 id INT PRIMARY KEY,
128 bytea INT NULL,
129 blob IMAGE NULL,
130 clob TEXT NULL
131 )
132 ],{ RaiseError => 1, PrintError => 1 });
133 }
134
135 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
136 $binstr{'large'} = $binstr{'small'} x 1024;
137
138 my $maxloblen = length $binstr{'large'};
139 note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
140 local $dbh->{'LongReadLen'} = $maxloblen;
141
142 my $rs = $schema->resultset('BindType');
143 my $id = 0;
144
bc54ca97 145 foreach my $type (qw(blob clob)) {
146 foreach my $size (qw(small large)) {
147 no warnings 'uninitialized';
148 $id++;
149
150 eval { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) };
151 ok(!$@, "inserted $size $type without dying");
152 diag $@ if $@;
153
154 ok(eval {
155 $rs->search({ id=> $id }, { select => [$type] })->single->$type
156 } eq $binstr{$size}, "verified inserted $size $type" );
64f4e691 157 diag $@ if $@;
e0b2344f 158 }
159 }
7d17f469 160
161 # try a blob update
162 TODO: {
163 local $TODO = 'updating TEXT/IMAGE does not work yet';
164
165 my $new_str = $binstr{large} . 'foo';
166 eval { $rs->search({ id => $id })->update({ blob => $new_str }) };
167 ok !$@, 'updated blob successfully';
168 diag $@ if $@;
169 ok(eval {
170 $rs->search({ id=> $id }, { select => ['blob'] })->single->blob
171 } eq $new_str, "verified updated blob" );
172 diag $@ if $@;
173 }
6b1f5ef7 174}
a964a928 175
176# clean up our mess
177END {
6b1f5ef7 178 if (my $dbh = eval { $schema->storage->_dbh }) {
179 $dbh->do('DROP TABLE artist');
e0b2344f 180 $dbh->do('DROP TABLE bindtype_test');
6b1f5ef7 181 }
a964a928 182}