Commit | Line | Data |
3a8aae80 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Exception; |
6 | use lib qw(t/lib); |
7 | use DBICTest; |
dff4c3a3 |
8 | use Scope::Guard (); |
3a8aae80 |
9 | |
10 | # tests stolen from 749sybase_asa.t |
11 | |
12 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_FIREBIRD_${_}" } qw/DSN USER PASS/}; |
13 | my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN USER PASS/}; |
14 | |
15 | plan skip_all => <<'EOF' unless $dsn || $dsn2; |
16 | Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN}, |
17 | _USER and _PASS to run these tests |
18 | EOF |
19 | |
20 | my @info = ( |
21 | [ $dsn, $user, $pass ], |
22 | [ $dsn2, $user2, $pass2 ], |
23 | ); |
24 | |
145b2a3d |
25 | my $schema; |
3a8aae80 |
26 | |
90489c23 |
27 | foreach my $conn_idx (0..1) { |
28 | my ($dsn, $user, $pass) = @{ $info[$conn_idx] }; |
3a8aae80 |
29 | |
30 | next unless $dsn; |
31 | |
145b2a3d |
32 | $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
3a8aae80 |
33 | my $dbh = $schema->storage->dbh; |
34 | |
dff4c3a3 |
35 | my $sg = Scope::Guard->new(\&cleanup); |
3a8aae80 |
36 | |
dff4c3a3 |
37 | eval { $dbh->do("DROP TABLE artist") }; |
3a8aae80 |
38 | $dbh->do(<<EOF); |
39 | CREATE TABLE artist ( |
40 | artistid INT PRIMARY KEY, |
41 | name VARCHAR(255), |
42 | charfield CHAR(10), |
43 | rank INT DEFAULT 13 |
44 | ) |
45 | EOF |
dff4c3a3 |
46 | eval { $dbh->do("DROP GENERATOR gen_artist_artistid") }; |
3a8aae80 |
47 | $dbh->do('CREATE GENERATOR gen_artist_artistid'); |
dff4c3a3 |
48 | eval { $dbh->do("DROP TRIGGER artist_bi") }; |
3a8aae80 |
49 | $dbh->do(<<EOF); |
50 | CREATE TRIGGER artist_bi FOR artist |
51 | ACTIVE BEFORE INSERT POSITION 0 |
52 | AS |
53 | BEGIN |
54 | IF (NEW.artistid IS NULL) THEN |
55 | NEW.artistid = GEN_ID(gen_artist_artistid,1); |
56 | END |
57 | EOF |
58 | |
59 | my $ars = $schema->resultset('Artist'); |
60 | is ( $ars->count, 0, 'No rows at first' ); |
61 | |
62 | # test primary key handling |
63 | my $new = $ars->create({ name => 'foo' }); |
64 | ok($new->artistid, "Auto-PK worked"); |
65 | |
66 | # test explicit key spec |
67 | $new = $ars->create ({ name => 'bar', artistid => 66 }); |
68 | is($new->artistid, 66, 'Explicit PK worked'); |
69 | $new->discard_changes; |
70 | is($new->artistid, 66, 'Explicit PK assigned'); |
71 | |
72 | # test populate |
73 | lives_ok (sub { |
74 | my @pop; |
75 | for (1..2) { |
76 | push @pop, { name => "Artist_$_" }; |
77 | } |
78 | $ars->populate (\@pop); |
79 | }); |
80 | |
81 | # test populate with explicit key |
82 | lives_ok (sub { |
83 | my @pop; |
84 | for (1..2) { |
85 | push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; |
86 | } |
145b2a3d |
87 | # XXX why does insert_bulk not work here? |
88 | my @foo = $ars->populate (\@pop); |
3a8aae80 |
89 | }); |
90 | |
91 | # count what we did so far |
92 | is ($ars->count, 6, 'Simple count works'); |
93 | |
94 | # test LIMIT support |
95 | my $lim = $ars->search( {}, |
96 | { |
97 | rows => 3, |
98 | offset => 4, |
99 | order_by => 'artistid' |
100 | } |
101 | ); |
102 | is( $lim->count, 2, 'ROWS+OFFSET count ok' ); |
103 | is( $lim->all, 2, 'Number of ->all objects matches count' ); |
104 | |
105 | # test iterator |
106 | $lim->reset; |
107 | is( $lim->next->artistid, 101, "iterator->next ok" ); |
108 | is( $lim->next->artistid, 102, "iterator->next ok" ); |
109 | is( $lim->next, undef, "next past end of resultset ok" ); |
110 | |
111 | # test empty insert |
112 | { |
113 | local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0; |
114 | |
115 | lives_ok { $ars->create({}) } |
116 | 'empty insert works'; |
117 | } |
118 | |
119 | # test blobs (stolen from 73oracle.t) |
145b2a3d |
120 | SKIP: { |
90489c23 |
121 | eval { $dbh->do('DROP TABLE bindtype_test2') }; |
145b2a3d |
122 | $dbh->do(q[ |
90489c23 |
123 | CREATE TABLE bindtype_test2 |
145b2a3d |
124 | ( |
125 | id INT PRIMARY KEY, |
126 | bytea INT, |
127 | a_blob BLOB, |
128 | a_clob BLOB SUB_TYPE TEXT |
129 | ) |
130 | ]); |
131 | |
145b2a3d |
132 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
133 | $binstr{'large'} = $binstr{'small'} x 1024; |
3a8aae80 |
134 | |
145b2a3d |
135 | my $maxloblen = length $binstr{'large'}; |
136 | local $dbh->{'LongReadLen'} = $maxloblen; |
3a8aae80 |
137 | |
90489c23 |
138 | my $rs = $schema->resultset('BindType2'); |
145b2a3d |
139 | my $id = 0; |
3a8aae80 |
140 | |
145b2a3d |
141 | foreach my $type (qw( a_blob a_clob )) { |
142 | foreach my $size (qw( small large )) { |
143 | $id++; |
3a8aae80 |
144 | |
145 | # turn off horrendous binary DBIC_TRACE output |
145b2a3d |
146 | local $schema->storage->{debug} = 0; |
3a8aae80 |
147 | |
145b2a3d |
148 | lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } |
149 | "inserted $size $type without dying"; |
3a8aae80 |
150 | |
145b2a3d |
151 | ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); |
152 | } |
3a8aae80 |
153 | } |
154 | } |
155 | } |
156 | |
157 | done_testing; |
158 | |
159 | # clean up our mess |
dff4c3a3 |
160 | |
161 | sub cleanup { |
145b2a3d |
162 | my $dbh; |
163 | eval { |
164 | $schema->storage->disconnect; # to avoid object FOO is in use errors |
165 | $dbh = $schema->storage->dbh; |
166 | }; |
167 | return unless $dbh; |
168 | |
169 | eval { $dbh->do('DROP TRIGGER artist_bi') }; |
170 | diag $@ if $@; |
171 | |
172 | eval { $dbh->do('DROP GENERATOR gen_artist_artistid') }; |
173 | diag $@ if $@; |
174 | |
175 | foreach my $table (qw/artist bindtype_test/) { |
176 | eval { $dbh->do("DROP TABLE $table") }; |
177 | #diag $@ if $@; |
3a8aae80 |
178 | } |
179 | } |