Commit | Line | Data |
4cbddf8d |
1 | use strict; |
3a89a69f |
2 | use warnings; |
3 | use Test::More; |
4 | use Scope::Guard (); |
4cbddf8d |
5 | use lib qw(t/lib); |
6 | use dbixcsl_common_tests; |
7 | |
c4a69b87 |
8 | my $dbd_firebird_dsn = $ENV{DBICTEST_FIREBIRD_DSN} || ''; |
9 | my $dbd_firebird_user = $ENV{DBICTEST_FIREBIRD_USER} || ''; |
10 | my $dbd_firebird_password = $ENV{DBICTEST_FIREBIRD_PASS} || ''; |
11 | |
12 | my $dbd_interbase_dsn = $ENV{DBICTEST_FIREBIRD_INTERBASE_DSN} || ''; |
13 | my $dbd_interbase_user = $ENV{DBICTEST_FIREBIRD_INTERBASE_USER} || ''; |
14 | my $dbd_interbase_password = $ENV{DBICTEST_FIREBIRD_INTERBASE_PASS} || ''; |
3a89a69f |
15 | |
16 | my $odbc_dsn = $ENV{DBICTEST_FIREBIRD_ODBC_DSN} || ''; |
17 | my $odbc_user = $ENV{DBICTEST_FIREBIRD_ODBC_USER} || ''; |
18 | my $odbc_password = $ENV{DBICTEST_FIREBIRD_ODBC_PASS} || ''; |
19 | |
20 | my $schema; |
4cbddf8d |
21 | |
22 | my $tester = dbixcsl_common_tests->new( |
23 | vendor => 'Firebird', |
24 | auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY', |
25 | auto_inc_cb => sub { |
26 | my ($table, $col) = @_; |
27 | return ( |
28 | qq{ CREATE GENERATOR gen_${table}_${col} }, |
29 | qq{ |
30 | CREATE TRIGGER ${table}_bi FOR $table |
31 | ACTIVE BEFORE INSERT POSITION 0 |
32 | AS |
33 | BEGIN |
34 | IF (NEW.$col IS NULL) THEN |
35 | NEW.$col = GEN_ID(gen_${table}_${col},1); |
36 | END |
37 | } |
38 | ); |
39 | }, |
40 | auto_inc_drop_cb => sub { |
41 | my ($table, $col) = @_; |
42 | return ( |
43 | qq{ DROP TRIGGER ${table}_bi }, |
44 | qq{ DROP GENERATOR gen_${table}_${col} }, |
45 | ); |
46 | }, |
47 | null => '', |
b511f36e |
48 | preserve_case_mode_is_exclusive => 1, |
49 | quote_char => '"', |
c4a69b87 |
50 | connect_info => [ |
51 | ($dbd_firebird_dsn ? { |
52 | dsn => $dbd_firebird_dsn, |
53 | user => $dbd_firebird_user, |
54 | password => $dbd_firebird_password, |
55 | connect_info_opts => { on_connect_call => 'use_softcommit' }, |
56 | } : ()), |
57 | ($dbd_interbase_dsn ? { |
3a89a69f |
58 | dsn => $dbd_interbase_dsn, |
59 | user => $dbd_interbase_user, |
60 | password => $dbd_interbase_password, |
61 | connect_info_opts => { on_connect_call => 'use_softcommit' }, |
62 | } : ()), |
63 | ($odbc_dsn ? { |
64 | dsn => $odbc_dsn, |
65 | user => $odbc_user, |
66 | password => $odbc_password, |
67 | } : ()), |
68 | ], |
cf0ba25b |
69 | data_types => { |
70 | # based on the Interbase Data Definition Guide |
71 | # http://www.ibphoenix.com/downloads/60DataDef.zip |
72 | # |
73 | # Numeric types |
74 | 'smallint' => { data_type => 'smallint' }, |
75 | 'int' => { data_type => 'integer' }, |
76 | 'integer' => { data_type => 'integer' }, |
77 | 'bigint' => { data_type => 'bigint' }, |
8ec0dd69 |
78 | 'float' => { data_type => 'real' }, |
cf0ba25b |
79 | 'double precision' => |
80 | { data_type => 'double precision' }, |
8ec0dd69 |
81 | 'real' => { data_type => 'real' }, |
cf0ba25b |
82 | |
8ec0dd69 |
83 | 'float(2)' => { data_type => 'real' }, |
84 | 'float(7)' => { data_type => 'real' }, |
cf0ba25b |
85 | 'float(8)' => { data_type => 'double precision' }, |
86 | |
87 | 'decimal' => { data_type => 'decimal' }, |
88 | 'dec' => { data_type => 'decimal' }, |
89 | 'numeric' => { data_type => 'numeric' }, |
90 | |
91 | 'decimal(3)' => { data_type => 'decimal', size => [3,0] }, |
92 | |
93 | 'decimal(3,3)' => { data_type => 'decimal', size => [3,3] }, |
94 | 'dec(3,3)' => { data_type => 'decimal', size => [3,3] }, |
95 | 'numeric(3,3)' => { data_type => 'numeric', size => [3,3] }, |
96 | |
0ae64d34 |
97 | 'decimal(6,3)' => { data_type => 'decimal', size => [6,3] }, |
98 | 'numeric(6,3)' => { data_type => 'numeric', size => [6,3] }, |
99 | |
100 | 'decimal(12,3)' => { data_type => 'decimal', size => [12,3] }, |
101 | 'numeric(12,3)' => { data_type => 'numeric', size => [12,3] }, |
102 | |
cf0ba25b |
103 | 'decimal(18,18)' => { data_type => 'decimal', size => [18,18] }, |
104 | 'dec(18,18)' => { data_type => 'decimal', size => [18,18] }, |
105 | 'numeric(18,18)' => { data_type => 'numeric', size => [18,18] }, |
106 | |
107 | # Date and Time Types |
108 | 'date' => { data_type => 'date' }, |
6e566cc4 |
109 | 'timestamp default current_timestamp' |
110 | => { data_type => 'timestamp', default_value => \'current_timestamp' }, |
cf0ba25b |
111 | 'time' => { data_type => 'time' }, |
112 | |
113 | # String Types |
114 | 'char' => { data_type => 'char', size => 1 }, |
115 | 'char(11)' => { data_type => 'char', size => 11 }, |
116 | 'varchar(20)' => { data_type => 'varchar', size => 20 }, |
5111e5d0 |
117 | 'char(22) character set unicode_fss' => |
118 | => { data_type => 'char(x) character set unicode_fss', size => 22 }, |
119 | 'varchar(33) character set unicode_fss' => |
120 | => { data_type => 'varchar(x) character set unicode_fss', size => 33 }, |
121 | |
cf0ba25b |
122 | # Blob types |
123 | 'blob' => { data_type => 'blob' }, |
124 | 'blob sub_type text' |
125 | => { data_type => 'blob sub_type text' }, |
5111e5d0 |
126 | 'blob sub_type text character set unicode_fss' |
127 | => { data_type => 'blob sub_type text character set unicode_fss' }, |
cf0ba25b |
128 | }, |
3a89a69f |
129 | extra => { |
0b763036 |
130 | create => [ |
131 | q{ |
132 | create table firebird_loader_test9 ( |
133 | id integer not null primary key |
134 | ) |
135 | }, |
136 | q{ |
137 | create table firebird_loader_test10 ( |
138 | id integer not null primary key, |
139 | nine_id integer, |
140 | foreign key (nine_id) references firebird_loader_test9(id) |
141 | on delete no action on update no action |
142 | ) |
143 | }, |
144 | q{ |
145 | create table firebird_loader_test11 ( |
146 | id integer not null primary key, |
147 | nine_id integer, |
148 | foreign key (nine_id) references firebird_loader_test9(id) |
149 | on delete cascade on update cascade |
150 | ) |
151 | }, |
152 | q{ |
153 | create table firebird_loader_test12 ( |
154 | id integer not null primary key, |
155 | nine_id integer, |
156 | foreign key (nine_id) references firebird_loader_test9(id) |
157 | on delete set default on update set default |
158 | ) |
159 | }, |
160 | q{ |
161 | create table firebird_loader_test13 ( |
162 | id integer not null primary key, |
163 | nine_id integer, |
164 | foreign key (nine_id) references firebird_loader_test9(id) |
165 | on delete set null on update set null |
166 | ) |
167 | }, |
168 | ], |
169 | drop => [ qw/firebird_loader_test9 firebird_loader_test10 firebird_loader_test11 |
170 | firebird_loader_test12 firebird_loader_test13/ ], |
171 | count => 4 * 4 + 9, |
3a89a69f |
172 | run => sub { |
173 | $schema = shift; |
1ad8e8c3 |
174 | my ($monikers, $classes, $self) = @_; |
3a89a69f |
175 | |
0b763036 |
176 | my %fk_tests = ( |
177 | 10 => 'NO ACTION', |
178 | 11 => 'CASCADE', |
179 | 12 => 'SET DEFAULT', |
180 | 13 => 'SET NULL', |
181 | ); |
182 | |
183 | # test on delete/update fk clause introspection |
184 | foreach my $tbl_num (qw/10 11 12 13/) { |
185 | ok ((my $rel_info = $schema->source("FirebirdLoaderTest${tbl_num}")->relationship_info('nine')), |
186 | 'got rel info'); |
187 | |
188 | is $rel_info->{attrs}{on_delete}, $fk_tests{$tbl_num}, |
189 | 'ON DELETE clause introspected correctly'; |
190 | |
191 | is $rel_info->{attrs}{on_update}, $fk_tests{$tbl_num}, |
192 | 'ON UPDATE clause introspected correctly'; |
193 | |
194 | is $rel_info->{attrs}{is_deferrable}, 1, |
195 | 'is_deferrable defaults to 1'; |
196 | } |
197 | |
3a89a69f |
198 | cleanup_extra(); |
199 | |
200 | my $dbh = $schema->storage->dbh; |
201 | |
202 | # create a mixed case table |
203 | $dbh->do($_) for ( |
204 | q{ |
205 | CREATE TABLE "Firebird_Loader_Test1" ( |
206 | "Id" INTEGER NOT NULL PRIMARY KEY, |
207 | "Foo" INTEGER DEFAULT 42 |
208 | ) |
209 | }, |
210 | q{ |
211 | CREATE GENERATOR "Gen_Firebird_Loader_Test1_Id" |
212 | }, |
213 | q{ |
214 | CREATE TRIGGER "Firebird_Loader_Test1_BI" for "Firebird_Loader_Test1" |
215 | ACTIVE BEFORE INSERT POSITION 0 |
216 | AS |
217 | BEGIN |
218 | IF (NEW."Id" IS NULL) THEN |
219 | NEW."Id" = GEN_ID("Gen_Firebird_Loader_Test1_Id",1); |
220 | END |
221 | }, |
222 | ); |
223 | |
224 | my $guard = Scope::Guard->new(\&cleanup_extra); |
225 | |
c4a69b87 |
226 | local $schema->loader->{preserve_case} = 1; |
227 | $schema->loader->_setup; |
ec957051 |
228 | |
1ad8e8c3 |
229 | $self->rescan_without_warnings($schema); |
3a89a69f |
230 | |
231 | ok ((my $rsrc = eval { $schema->resultset('FirebirdLoaderTest1')->result_source }), |
232 | 'got rsrc for mixed case table'); |
233 | |
234 | ok ((my $col_info = eval { $rsrc->column_info('Id') }), |
235 | 'got column_info for column Id'); |
236 | |
237 | is $col_info->{accessor}, 'id', 'column Id has lowercase accessor "id"'; |
238 | |
239 | is $col_info->{is_auto_increment}, 1, 'is_auto_increment detected for mixed case trigger'; |
240 | |
241 | is $col_info->{sequence}, 'Gen_Firebird_Loader_Test1_Id', 'correct mixed case sequence name'; |
242 | |
243 | is eval { $rsrc->column_info('Foo')->{default_value} }, 42, 'default_value detected for mixed case column'; |
5111e5d0 |
244 | |
245 | # test the fixed up ->_dbh_type_info_type_name for the ODBC driver |
246 | if ($schema->storage->_dbi_connect_info->[0] =~ /:ODBC:/i) { |
247 | my %truncated_types = ( |
248 | 4 => 'INTEGER', |
249 | -9 => 'VARCHAR(x) CHARACTER SET UNICODE_FSS', |
250 | -10 => 'BLOB SUB_TYPE TEXT CHARACTER SET UNICODE_FSS', |
251 | ); |
252 | |
253 | for my $type_num (keys %truncated_types) { |
c4a69b87 |
254 | is $schema->loader->_dbh_type_info_type_name($type_num), |
5111e5d0 |
255 | $truncated_types{$type_num}, |
256 | "ODBC ->_dbh_type_info_type_name correct for '$truncated_types{$type_num}'"; |
257 | } |
258 | } |
259 | else { |
260 | my $tb = Test::More->builder; |
261 | $tb->skip('not testing _dbh_type_info_type_name on DBD::InterBase') for 1..3; |
262 | } |
3a89a69f |
263 | }, |
264 | }, |
4cbddf8d |
265 | ); |
266 | |
c4a69b87 |
267 | if (not ($dbd_firebird_dsn || $dbd_interbase_dsn || $odbc_dsn)) { |
268 | $tester->skip_tests('You need to set the DBICTEST_FIREBIRD_DSN, _USER and _PASS and/or the DBICTEST_FIREBIRD_INTERBASE_DSN and/or the DBICTEST_FIREBIRD_ODBC_DSN environment variables'); |
4cbddf8d |
269 | } |
270 | else { |
4145a6f3 |
271 | # get rid of stupid warning from InterBase/GetInfo.pm |
3a89a69f |
272 | if ($dbd_interbase_dsn) { |
e32d24a5 |
273 | local $SIG{__WARN__} = sub { warn @_ |
c4a69b87 |
274 | unless $_[0] =~ m{^Use of uninitialized value in sprintf at \S+DBD/InterBase/GetInfo\.pm line \d+\.$|^Missing argument in sprintf at \S+DBD/InterBase/GetInfo.pm line \d+\.$} }; |
4145a6f3 |
275 | require DBD::InterBase; |
276 | require DBD::InterBase::GetInfo; |
277 | } |
c4a69b87 |
278 | |
4cbddf8d |
279 | $tester->run_tests(); |
280 | } |
3a89a69f |
281 | |
282 | sub cleanup_extra { |
283 | $schema->storage->disconnect; |
284 | my $dbh = $schema->storage->dbh; |
285 | |
286 | foreach my $stmt ( |
287 | 'DROP TRIGGER "Firebird_Loader_Test1_BI"', |
288 | 'DROP GENERATOR "Gen_Firebird_Loader_Test1_Id"', |
289 | 'DROP TABLE "Firebird_Loader_Test1"', |
290 | ) { |
291 | eval { $dbh->do($stmt) }; |
292 | } |
293 | } |
e32d24a5 |
294 | # vim:et sts=4 sw=4 tw=0: |