1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
6use lib qw(t/lib);
7use DBICTest;
8
9# tests stolen from 748informix.t
10
11my ($dsn, $user, $pass)    = @ENV{map { "DBICTEST_SYBASE_ASA_${_}" }      qw/DSN USER PASS/};
12my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SYBASE_ASA_ODBC_${_}" } qw/DSN USER PASS/};
13
14plan skip_all => <<'EOF' unless $dsn || $dsn2;
15Set $ENV{DBICTEST_SYBASE_ASA_DSN} and/or $ENV{DBICTEST_SYBASE_ASA_ODBC_DSN},
16_USER and _PASS to run these tests
17EOF
18
19my @info = (
20  [ $dsn,  $user,  $pass  ],
21  [ $dsn2, $user2, $pass2 ],
22);
23
24my @handles_to_clean;
25
26foreach my $info (@info) {
27  my ($dsn, $user, $pass) = @$info;
28
29  next unless $dsn;
30
31  my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
32    auto_savepoint => 1
33  });
34
35  my $dbh = $schema->storage->dbh;
36
37  push @handles_to_clean, $dbh;
38
39  eval { $dbh->do("DROP TABLE artist") };
40
41  $dbh->do(<<EOF);
42  CREATE TABLE artist (
43    artistid INT IDENTITY PRIMARY KEY,
44    name VARCHAR(255) NULL,
45    charfield CHAR(10) NULL,
46    rank INT DEFAULT 13
47  )
48EOF
49
50  my $ars = $schema->resultset('Artist');
51  is ( $ars->count, 0, 'No rows at first' );
52
53# test primary key handling
54  my $new = $ars->create({ name => 'foo' });
55  ok($new->artistid, "Auto-PK worked");
56
57# test explicit key spec
58  $new = $ars->create ({ name => 'bar', artistid => 66 });
59  is($new->artistid, 66, 'Explicit PK worked');
60  $new->discard_changes;
61  is($new->artistid, 66, 'Explicit PK assigned');
62
63# test savepoints
64  eval {
65    $schema->txn_do(sub {
66      eval {
67        $schema->txn_do(sub {
68          $ars->create({ name => 'in_savepoint' });
69          die "rolling back savepoint";
70        });
71      };
72      ok ((not $ars->search({ name => 'in_savepoint' })->first),
73        'savepoint rolled back');
74      $ars->create({ name => 'in_outer_txn' });
75      die "rolling back outer txn";
76    });
77  };
78
79  like $@, qr/rolling back outer txn/,
80    'correct exception for rollback';
81
82  ok ((not $ars->search({ name => 'in_outer_txn' })->first),
83    'outer txn rolled back');
84
85# test populate
86  lives_ok (sub {
87    my @pop;
88    for (1..2) {
89      push @pop, { name => "Artist_$_" };
90    }
91    $ars->populate (\@pop);
92  });
93
94# test populate with explicit key
95  lives_ok (sub {
96    my @pop;
97    for (1..2) {
98      push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
99    }
100    $ars->populate (\@pop);
101  });
102
103# count what we did so far
104  is ($ars->count, 6, 'Simple count works');
105
106# test LIMIT support
107  my $lim = $ars->search( {},
108    {
109      rows => 3,
110      offset => 4,
111      order_by => 'artistid'
112    }
113  );
114  is( $lim->count, 2, 'ROWS+OFFSET count ok' );
115  is( $lim->all, 2, 'Number of ->all objects matches count' );
116
117# test iterator
118  $lim->reset;
119  is( $lim->next->artistid, 101, "iterator->next ok" );
120  is( $lim->next->artistid, 102, "iterator->next ok" );
121  is( $lim->next, undef, "next past end of resultset ok" );
122
123# test empty insert
124  {
125    local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0;
126
127    lives_ok { $ars->create({}) }
128      'empty insert works';
129  }
130
131# test blobs (stolen from 73oracle.t)
132  eval { $dbh->do('DROP TABLE bindtype_test') };
133  $dbh->do(qq[
134  CREATE TABLE bindtype_test
135  (
136    id    INT          NOT NULL PRIMARY KEY,
137    bytea INT          NULL,
138    blob  LONG BINARY  NULL,
139    clob  LONG VARCHAR NULL
140  )
141  ],{ RaiseError => 1, PrintError => 1 });
142
143  my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
144  $binstr{'large'} = $binstr{'small'} x 1024;
145
146  my $maxloblen = length $binstr{'large'};
147  local $dbh->{'LongReadLen'} = $maxloblen;
148
149  my $rs = $schema->resultset('BindType');
150  my $id = 0;
151
152  foreach my $type (qw( blob clob )) {
153    foreach my $size (qw( small large )) {
154      $id++;
155
156# turn off horrendous binary DBIC_TRACE output
157      local $schema->storage->{debug} = 0;
158
159      lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
160      "inserted $size $type without dying";
161
162      ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
163    }
164  }
165}
166
167done_testing;
168
169# clean up our mess
170END {
171  foreach my $dbh (@handles_to_clean) {
172    eval { $dbh->do("DROP TABLE $_") } for qw/artist bindtype_test/;
173  }
174}
175