1 #!/usr/bin/perl -w -I./t
4 # vim:ts=2:sw=2:ai:aw:nu:
5 use DBI qw(:sql_types);
9 if (defined $ENV{DBI_DSN}) {
12 plan skip_all => 'cannot test without DB info';
15 my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
16 {RaiseError => 1, AutoCommit => 0}
19 'connect with transaction'
23 # Test the different methods, so are expected to fail.
28 # foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
30 # printf "%s=%d\n", $_, &{"DBI::$_"};
36 , SQL_IDENTIFIER_QUOTE_CHAR => 29
37 , SQL_CATALOG_NAME_SEPARATOR => 41
38 , SQL_CATALOG_LOCATION => 114
43 ok( $dbh->ping(), "Testing Ping" );
45 ok ( !$@, "Ping Tested" );
49 $sth = $dbh->get_info();
51 ok ($@, "Call to get_info with 0 arguements, error expected: $@" );
56 $sth = $dbh->table_info();
58 ok ((!$@ and defined $sth), "table_info tested" );
63 $sth = $dbh->column_info();
65 ok ((!$@ and defined $sth), "column_info tested" );
66 #ok ($@, "Call to column_info with 0 arguements, error expected: $@" );
72 $sth = $dbh->tables();
74 ok ((!$@ and defined $sth), "tables tested" );
79 $sth = $dbh->type_info_all();
81 ok ((!$@ and defined $sth), "type_info_all tested" );
86 my @types = $dbh->type_info();
89 ok (!$@, "type_info(undef)");
94 my $val = $dbh->quote();
97 ok ($@, "quote error expected: $@");
101 my @qt_vals = (1, 2, undef, 'NULL', "ThisIsAString", "This is Another String");
102 my @expt_vals = (q{'1'}, q{'2'}, "NULL", q{'NULL'}, q{'ThisIsAString'}, q{'This is Another String'});
103 for (my $x = 0; $x <= $#qt_vals; $x++) {
105 my $val = $dbh->quote( $qt_vals[$x] );
106 is( $val, $expt_vals[$x], "$x: quote on $qt_vals[$x] returned $val" );
109 is( $dbh->quote( 1, SQL_INTEGER() ), 1, "quote(1, SQL_INTEGER)" );
114 my $val = $dbh->quote_identifier();
118 ok ($@, "quote_identifier error expected: $@");
122 skip("get_info() not yet implemented", 1);
123 # , SQL_IDENTIFIER_QUOTE_CHAR => 29
124 # , SQL_CATALOG_NAME_SEPARATOR => 41
125 my $qt = $dbh->get_info( $get_info->{SQL_IDENTIFIER_QUOTE_CHAR} );
126 my $sep = $dbh->get_info( $get_info->{SQL_CATALOG_NAME_SEPARATOR} );
128 # Uncomment this line and remove the next line when get_info() is implemented.
129 # my $cmp_str = qq{${qt}link${qt}${sep}${qt}schema${qt}${sep}${qt}table${qt}};
131 is( $dbh->quote_identifier( "link", "schema", "table" )
133 , q{quote_identifier( "link", "schema", "table" )}
139 ok ($dbh->ping, "Ping the current connection ..." );
145 # SQL_DATA_SOURCE_NAME
156 skip("get_info() not yet implemented", 5);
157 foreach my $info (sort keys %$get_info) {
158 my $type = $dbh->get_info($get_info->{$info});
159 ok( defined $type, "get_info($info) ($get_info->{$info}) " .
165 $sth = $dbh->table_info( undef, undef, undef );
166 ok( defined $sth, "table_info(undef, undef, undef) tested" );
167 DBI::dump_results($sth) if defined $sth;
170 $sth = $dbh->table_info( undef, undef, undef, "VIEW" );
171 ok( defined $sth, "table_info(undef, undef, undef, \"VIEW\") tested" );
172 DBI::dump_results($sth) if defined $sth;
175 # Test Table Info Rule 19a
176 $sth = $dbh->table_info( '%', '', '');
177 ok( defined $sth, "table_info('%', '', '',) tested" );
178 DBI::dump_results($sth) if defined $sth;
181 # Test Table Info Rule 19b
182 $sth = $dbh->table_info( '', '%', '');
183 ok( defined $sth, "table_info('', '%', '',) tested" );
184 DBI::dump_results($sth) if defined $sth;
187 # Test Table Info Rule 19c
188 $sth = $dbh->table_info( '', '', '', '%');
189 ok( defined $sth, "table_info('', '', '', '%',) tested" );
190 DBI::dump_results($sth) if defined $sth;
193 # Test to see if this database contains any of the defined table types.
194 $sth = $dbh->table_info( '', '', '', '%');
195 ok( defined $sth, "table_info('', '', '', '%',) tested" );
197 my $ref = $sth->fetchall_hashref( 'TABLE_TYPE' );
198 foreach my $type ( sort keys %$ref ) {
199 my $tsth = $dbh->table_info( undef, undef, undef, $type );
200 ok( defined $tsth, "table_info(undef, undef, undef, $type) tested" );
201 DBI::dump_results($tsth) if defined $tsth;
209 $sth = $dbh->column_info( undef, undef, undef, undef );
210 ok( defined $sth, "column_info(undef, undef, undef, undef) tested" );
211 DBI::dump_results($sth) if defined $sth;
214 $sth = $dbh->column_info( undef, "'auser'", undef, undef );
215 ok( defined $sth, "column_info(undef, 'auser', undef, undef) tested" );
216 DBI::dump_results($sth) if defined $sth;
219 $sth = $dbh->column_info( undef, "'ause%'", undef, undef );
220 ok( defined $sth, "column_info(undef, 'ause%', undef, undef) tested" );
221 DBI::dump_results($sth) if defined $sth;
224 $sth = $dbh->column_info( undef, "'auser','replicator'", undef, undef );
225 ok( defined $sth, "column_info(undef, 'auser','replicator', undef, undef) tested" );
226 DBI::dump_results($sth) if defined $sth;
229 $sth = $dbh->column_info( undef, "'auser','repl%'", undef, undef );
230 ok( defined $sth, "column_info(undef, 'auser','repl%', undef, undef) tested" );
231 DBI::dump_results($sth) if defined $sth;
234 $sth = $dbh->column_info( undef, "'fred','repl%'", undef, undef );
235 ok( defined $sth, "column_info(undef, 'fred','repl%', undef, undef) tested" );
236 DBI::dump_results($sth) if defined $sth;
239 $sth = $dbh->column_info( undef, "'fred','jim'", undef, undef );
240 ok( defined $sth, "column_info(undef, 'fred','jim', undef, undef) tested" );
241 DBI::dump_results($sth) if defined $sth;
244 $sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", undef );
245 ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', undef) tested" );
246 DBI::dump_results($sth) if defined $sth;
249 $sth = $dbh->column_info( undef, "'auser'", "'pga_%'", undef );
250 ok( defined $sth, "column_info(undef, 'auser', 'pga_%', undef) tested" );
251 DBI::dump_results($sth) if defined $sth;
254 $sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", undef );
255 ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', undef) tested" );
256 DBI::dump_results($sth) if defined $sth;
259 $sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schemaname'" );
260 ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schemaname') tested" );
261 DBI::dump_results($sth) if defined $sth;
264 $sth = $dbh->column_info( undef, "'auser'", "'pga_schema'", "'schema%'" );
265 ok( defined $sth, "column_info(undef, 'auser', 'pga_schema', 'schema%') tested" );
266 DBI::dump_results($sth) if defined $sth;
269 $sth = $dbh->column_info( undef, "'auser'", "'pga_%'", "'schema%'" );
270 ok( defined $sth, "column_info(undef, 'auser', 'pga_%', 'schema%') tested" );
271 DBI::dump_results($sth) if defined $sth;
274 $sth = $dbh->column_info( undef, "'ause%'", "'pga_%'", "'schema%'" );
275 ok( defined $sth, "column_info(undef, 'ause%', 'pga_%', 'schema%') tested" );
276 DBI::dump_results($sth) if defined $sth;
279 # Test call to primary_key_info
280 local ($dbh->{Warn}, $dbh->{PrintError});
281 $dbh->{PrintError} = $dbh->{Warn} = 0;
285 $sth = $dbh->primary_key_info();
288 ok ($@, "Call to primary_key_info with 0 arguements, error expected: $@" );
293 $sth = $dbh->primary_key();
296 ok ($@, "Call to primary_key with 0 arguements, error expected: $@" );
299 $sth = $dbh->primary_key_info(undef, undef, undef );
301 ok( defined $sth, "Statement handle defined for primary_key_info()" );
303 if ( defined $sth ) {
304 while( my $row = $sth->fetchrow_arrayref ) {
306 # print join( ", ", @$row, "\n" );
313 $sth = $dbh->primary_key_info(undef, undef, undef );
314 ok( defined $sth, "Statement handle defined for primary_key_info()" );
316 my ( %catalogs, %schemas, %tables);
319 while( my ($catalog, $schema, $table) = $sth->fetchrow_array ) {
321 $catalogs{$catalog}++ if $catalog;
322 $schemas{$schema}++ if $schema;
323 $tables{$table}++ if $table;
326 ok( $cnt > 0, "At least one table has a primary key." );
328 $sth = $dbh->primary_key_info(undef, qq{'$ENV{DBI_USER}'}, undef );
331 , "Getting primary keys for tables owned by $ENV{DBI_USER}");
332 DBI::dump_results($sth) if defined $sth;
338 local ($dbh->{Warn}, $dbh->{PrintError});
339 $dbh->{PrintError} = $dbh->{Warn} = 0;
341 $sth = $dbh->foreign_key_info();
344 skip "foreign_key_info not supported by driver", 1 if $@;
345 ok( defined $sth, "Statement handle defined for foreign_key_info()" );
346 DBI::dump_results($sth) if defined $sth;
350 ok( $dbh->disconnect, "Disconnect from database" );