install/5.005/DBD-Pg-1.22-fixvercmp/t/15funct.t

   1 #!/usr/bin/perl -w -I./t
   2 $| = 1;
   3
   4 # vim:ts=2:sw=2:ai:aw:nu:
   5 use DBI qw(:sql_types);
   6 use Data::Dumper;
   7 use strict;
   8 use Test::More;
   9 if (defined $ENV{DBI_DSN}) {
  10   plan tests => 59;
  11 } else {
  12   plan skip_all => 'cannot test without DB info';
  13 }
  14
  15 my $dbh = DBI->connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS},
  16                        {RaiseError => 1, AutoCommit => 0}
  17                       );
  18 ok(defined $dbh,
  19    'connect with transaction'
  20   );
  21
  22 #
  23 # Test the different methods, so are expected to fail.
  24 #
  25
  26 my $sth;
  27
  28 # foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
  29 #       no strict 'refs';
  30 #       printf "%s=%d\n", $_, &{"DBI::$_"};
  31 # }
  32
  33 my $get_info = {
  34           SQL_DBMS_NAME => 17
  35         , SQL_DBMS_VER  => 18
  36         , SQL_IDENTIFIER_QUOTE_CHAR     => 29
  37         , SQL_CATALOG_NAME_SEPARATOR    => 41
  38         , SQL_CATALOG_LOCATION  => 114
  39 };
  40
  41 # Ping
  42  eval {
  43          ok( $dbh->ping(), "Testing Ping" );
  44  };
  45 ok ( !$@, "Ping Tested" );
  46
  47 # Get Info
  48  eval {
  49          $sth = $dbh->get_info();
  50  };
  51 ok ($@, "Call to get_info with 0 arguements, error expected: $@" );
  52 $sth = undef;
  53
  54 # Table Info
  55  eval {
  56          $sth = $dbh->table_info();
  57  };
  58 ok ((!$@ and defined $sth), "table_info tested" );
  59 $sth = undef;
  60
  61 # Column Info
  62  eval {
  63          $sth = $dbh->column_info();
  64  };
  65 ok ((!$@ and defined $sth), "column_info tested" );
  66 #ok ($@, "Call to column_info with 0 arguements, error expected: $@" );
  67 $sth = undef;
  68
  69
  70 # Tables
  71  eval {
  72          $sth = $dbh->tables();
  73  };
  74 ok ((!$@ and defined $sth), "tables tested" );
  75 $sth = undef;
  76
  77 # Type Info All
  78  eval {
  79          $sth = $dbh->type_info_all();
  80  };
  81 ok ((!$@ and defined $sth), "type_info_all tested" );
  82 $sth = undef;
  83
  84 # Type Info
  85  eval {
  86         my @types = $dbh->type_info();
  87         die unless @types;
  88  };
  89 ok (!$@, "type_info(undef)");
  90 $sth = undef;
  91
  92 # Quote
  93  eval {
  94         my $val = $dbh->quote();
  95         die unless $val;
  96  };
  97 ok ($@, "quote error expected: $@");
  98
  99 $sth = undef;
 100 # Tests for quote:
 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++) {
 104         local $^W = 0;
 105         my $val = $dbh->quote( $qt_vals[$x] );
 106         is( $val, $expt_vals[$x], "$x: quote on $qt_vals[$x] returned $val" );
 107 }
 108
 109 is( $dbh->quote( 1, SQL_INTEGER() ), 1, "quote(1, SQL_INTEGER)" );
 110
 111
 112 # Quote Identifier
 113  eval {
 114         my $val = $dbh->quote_identifier();
 115         die unless $val;
 116  };
 117
 118 ok ($@, "quote_identifier error expected: $@");
 119 $sth = undef;
 120
 121 SKIP: {
 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} );
 127
 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}};
 130     my $cmp_str = '';
 131     is( $dbh->quote_identifier( "link", "schema", "table" )
 132         , $cmp_str
 133         , q{quote_identifier( "link", "schema", "table" )}
 134       );
 135 }
 136
 137 # Test ping
 138
 139 ok ($dbh->ping, "Ping the current connection ..." );
 140
 141 # Test Get Info.
 142
 143 #       SQL_KEYWORDS
 144 #       SQL_CATALOG_TERM
 145 #       SQL_DATA_SOURCE_NAME
 146 #       SQL_DBMS_NAME
 147 #       SQL_DBMS_VERSION
 148 #       SQL_DRIVER_NAME
 149 #       SQL_DRIVER_VER
 150 #       SQL_PROCEDURE_TERM
 151 #       SQL_SCHEMA_TERM
 152 #       SQL_TABLE_TERM
 153 #       SQL_USER_NAME
 154
 155 SKIP: {
 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}) " .
 160             ($type || '') );
 161     }
 162 }
 163
 164 # Test Table 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;
 168 $sth = undef;
 169
 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;
 173 $sth = undef;
 174
 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;
 179 $sth = undef;
 180
 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;
 185 $sth = undef;
 186
 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;
 191 $sth = undef;
 192
 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" );
 196 if ($sth) {
 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;
 202                 $tsth->finish;
 203         }
 204         $sth->finish;
 205 }
 206 $sth = undef;
 207
 208 # Test Column Info
 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;
 212 $sth = undef;
 213
 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;
 217 $sth = undef;
 218
 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;
 222 $sth = undef;
 223
 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;
 227 $sth = undef;
 228
 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;
 232 $sth = undef;
 233
 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;
 237 $sth = undef;
 238
 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;
 242 $sth = undef;
 243
 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;
 247 $sth = undef;
 248
 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;
 252 $sth = undef;
 253
 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;
 257 $sth = undef;
 258
 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;
 262 $sth = undef;
 263
 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;
 267 $sth = undef;
 268
 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;
 272 $sth = undef;
 273
 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;
 277 $sth = undef;
 278
 279 # Test call to primary_key_info
 280 local ($dbh->{Warn}, $dbh->{PrintError});
 281 $dbh->{PrintError} = $dbh->{Warn} = 0;
 282
 283 # Primary Key Info
 284 eval {
 285     $sth = $dbh->primary_key_info();
 286     die unless $sth;
 287 };
 288 ok ($@, "Call to primary_key_info with 0 arguements, error expected: $@" );
 289 $sth = undef;
 290
 291 # Primary Key
 292 eval {
 293     $sth = $dbh->primary_key();
 294     die unless $sth;
 295 };
 296 ok ($@, "Call to primary_key with 0 arguements, error expected: $@" );
 297 $sth = undef;
 298
 299 $sth = $dbh->primary_key_info(undef, undef, undef );
 300
 301 ok( defined $sth, "Statement handle defined for primary_key_info()" );
 302
 303 if ( defined $sth ) {
 304     while( my $row = $sth->fetchrow_arrayref ) {
 305         local $^W = 0;
 306         # print join( ", ", @$row, "\n" );
 307     }
 308
 309     undef $sth;
 310
 311 }
 312
 313 $sth = $dbh->primary_key_info(undef, undef, undef );
 314 ok( defined $sth, "Statement handle defined for primary_key_info()" );
 315
 316 my ( %catalogs, %schemas, %tables);
 317
 318 my $cnt = 0;
 319 while( my ($catalog, $schema, $table) = $sth->fetchrow_array ) {
 320     local $^W = 0;
 321     $catalogs{$catalog}++       if $catalog;
 322     $schemas{$schema}++         if $schema;
 323     $tables{$table}++                   if $table;
 324     $cnt++;
 325 }
 326 ok( $cnt > 0, "At least one table has a primary key." );
 327
 328 $sth = $dbh->primary_key_info(undef, qq{'$ENV{DBI_USER}'}, undef );
 329 ok(
 330    defined $sth
 331    , "Getting primary keys for tables owned by $ENV{DBI_USER}");
 332 DBI::dump_results($sth) if defined $sth;
 333
 334 undef $sth;
 335
 336 SKIP: {
 337         # foreign_key_info
 338         local ($dbh->{Warn}, $dbh->{PrintError});
 339         $dbh->{PrintError} = $dbh->{Warn} = 0;
 340         eval {
 341         $sth = $dbh->foreign_key_info();
 342                 die unless $sth;
 343         };
 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;
 347         $sth = undef;
 348 }
 349
 350 ok( $dbh->disconnect, "Disconnect from database" );
 351
 352 exit(0);
 353