[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package DBI::DBD::Metadata; 2 3 # $Id: Metadata.pm 8696 2007-01-24 23:12:38Z timbo $ 4 # 5 # Copyright (c) 1997-2003 Jonathan Leffler, Jochen Wiedmann, 6 # Steffen Goeldner and Tim Bunce 7 # 8 # You may distribute under the terms of either the GNU General Public 9 # License or the Artistic License, as specified in the Perl README file. 10 11 use Exporter (); 12 use Carp; 13 14 use DBI; 15 use DBI::Const::GetInfoType qw(%GetInfoType); 16 17 # Perl 5.005_03 does not recognize 'our' 18 @ISA = qw(Exporter); 19 @EXPORT = qw(write_getinfo_pm write_typeinfo_pm); 20 21 $VERSION = sprintf("2.%06d", q$Revision: 8696 $ =~ /(\d+)/o); 22 23 24 use strict; 25 26 =head1 NAME 27 28 DBI::DBD::Metadata - Generate the code and data for some DBI metadata methods 29 30 =head1 SYNOPSIS 31 32 The idea is to extract metadata information from a good quality 33 ODBC driver and use it to generate code and data to use in your own 34 DBI driver for the same database. 35 36 For generating code to support the get_info method: 37 38 perl -MDBI::DBD::Metadata -e "write_getinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')" 39 40 perl -MDBI::DBD::Metadata -e write_getinfo_pm dbi:ODBC:foo_db username password Driver 41 42 For generating code to support the type_info method: 43 44 perl -MDBI::DBD::Metadata -e "write_typeinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')" 45 46 perl -MDBI::DBD::Metadata -e write_typeinfo_pm dbi:ODBC:dsn-name user pass Driver 47 48 Where C<dbi:ODBC:dsn-name> is the connection to use to extract the 49 data, and C<Driver> is the name of the driver you want the code 50 generated for (the driver name gets embedded into the output in 51 many places). 52 53 =head1 Generating a GetInfo package for a driver 54 55 The C<write_getinfo_pm> in the DBI::DBD::Metadata module generates a 56 DBD::Driver::GetInfo package on standard output. 57 58 This method generates a DBD::Driver::GetInfo package from the data 59 source you specified in the parameter list or in the environment 60 variable DBI_DSN. 61 DBD::Driver::GetInfo should help a DBD author implementing the DBI 62 get_info() method. 63 Because you are just creating this package, it's very unlikely that 64 DBD::Driver already provides a good implementation for get_info(). 65 Thus you will probably connect via DBD::ODBC. 66 67 Once you are sure that it is producing semi-sane data, you would 68 typically redirect the standard output to lib/DBD/Driver/GetInfo.pm, and 69 then hand edit the result. 70 Do not forget to update your Makefile.PL and MANIFEST to include this as 71 an extra PM file that should be installed. 72 73 If you connect via DBD::ODBC, you should use version 0.38 or greater; 74 75 Please take a critical look at the data returned! 76 ODBC drivers vary dramatically in their quality. 77 78 The generator assumes that most values are static and places these 79 values directly in the %info hash. 80 A few examples show the use of CODE references and the implementation 81 via subroutines. 82 It is very likely that you have to write additional subroutines for 83 values depending on the session state or server version, e.g. 84 SQL_DBMS_VER. 85 86 A possible implementation of DBD::Driver::db::get_info() may look like: 87 88 sub get_info { 89 my($dbh, $info_type) = @_; 90 require DBD::Driver::GetInfo; 91 my $v = $DBD::Driver::GetInfo::info{int($info_type)}; 92 $v = $v->($dbh) if ref $v eq 'CODE'; 93 return $v; 94 } 95 96 Please replace Driver (or "<foo>") with the name of your driver. 97 Note that this stub function is generated for you by write_getinfo_pm 98 function, but you must manually transfer the code to Driver.pm. 99 100 =cut 101 102 sub write_getinfo_pm 103 { 104 my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV; 105 my $dbh = DBI->connect($dsn, $user, $pass, {RaiseError=>1}); 106 $driver = "<foo>" unless defined $driver; 107 108 print <<PERL; 109 110 # Transfer this to ${driver}.pm 111 112 # The get_info function was automatically generated by 113 # DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION. 114 115 package DBD::$driver}::db; # This line can be removed once transferred. 116 117 sub get_info { 118 my(\$dbh, \$info_type) = \@_; 119 require DBD::$driver}::GetInfo; 120 my \$v = \$DBD::$driver}::GetInfo::info{int(\$info_type)}; 121 \$v = \$v->(\$dbh) if ref \$v eq 'CODE'; 122 return \$v; 123 } 124 125 # Transfer this to lib/DBD/${driver}/GetInfo.pm 126 127 # The \%info hash was automatically generated by 128 # DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION. 129 130 package DBD::$driver}::GetInfo; 131 132 use strict; 133 use DBD::$driver}; 134 135 # Beware: not officially documented interfaces... 136 # use DBI::Const::GetInfoType qw(\%GetInfoType); 137 # use DBI::Const::GetInfoReturn qw(\%GetInfoReturnTypes \%GetInfoReturnValues); 138 139 my \$sql_driver = '$driver}'; 140 my \$sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.##### 141 my \$sql_driver_ver = sprintf \$sql_ver_fmt, split (/\\./, \$DBD::$driver}::VERSION); 142 PERL 143 144 my $kw_map = 0; 145 { 146 # Informix CLI (ODBC) v3.81.0000 does not return a list of keywords. 147 local $\ = "\n"; 148 local $, = "\n"; 149 my ($kw) = $dbh->get_info($GetInfoType{SQL_KEYWORDS}); 150 if ($kw) 151 { 152 print "\nmy \@Keywords = qw(\n"; 153 print sort split /,/, $kw; 154 print ");\n\n"; 155 print "sub sql_keywords {\n"; 156 print q% return join ',', @Keywords;%; 157 print "\n}\n\n"; 158 $kw_map = 1; 159 } 160 } 161 162 print <<'PERL'; 163 164 sub sql_data_source_name { 165 my $dbh = shift; 166 return "dbi:$sql_driver:" . $dbh->{Name}; 167 } 168 169 sub sql_user_name { 170 my $dbh = shift; 171 # CURRENT_USER is a non-standard attribute, probably undef 172 # Username is a standard DBI attribute 173 return $dbh->{CURRENT_USER} || $dbh->{Username}; 174 } 175 176 PERL 177 178 print "\nour \%info = (\n"; 179 foreach my $key (sort keys %GetInfoType) 180 { 181 my $num = $GetInfoType{$key}; 182 my $val = eval { $dbh->get_info($num); }; 183 if ($key eq 'SQL_DATA_SOURCE_NAME') { 184 $val = '\&sql_data_source_name'; 185 } 186 elsif ($key eq 'SQL_KEYWORDS') { 187 $val = ($kw_map) ? '\&sql_keywords' : 'undef'; 188 } 189 elsif ($key eq 'SQL_DRIVER_NAME') { 190 $val = "\$INC{'DBD/$driver.pm'}"; 191 } 192 elsif ($key eq 'SQL_DRIVER_VER') { 193 $val = '$sql_driver_ver'; 194 } 195 elsif ($key eq 'SQL_USER_NAME') { 196 $val = '\&sql_user_name'; 197 } 198 elsif (not defined $val) { 199 $val = 'undef'; 200 } 201 elsif ($val eq '') { 202 $val = "''"; 203 } 204 elsif ($val =~ /\D/) { 205 $val =~ s/\\/\\\\/g; 206 $val =~ s/'/\\'/g; 207 $val = "'$val'"; 208 } 209 printf "%s %5d => %-30s # %s\n", (($val eq 'undef') ? '#' : ' '), $num, "$val,", $key; 210 } 211 print ");\n\n1;\n\n__END__\n"; 212 } 213 214 215 216 =head1 Generating a TypeInfo package for a driver 217 218 The C<write_typeinfo_pm> function in the DBI::DBD::Metadata module generates 219 on standard output the data needed for a driver's type_info_all method. 220 It also provides default implementations of the type_info_all 221 method for inclusion in the driver's main implementation file. 222 223 The driver parameter is the name of the driver for which the methods 224 will be generated; for the sake of examples, this will be "Driver". 225 Typically, the dsn parameter will be of the form "dbi:ODBC:odbc_dsn", 226 where the odbc_dsn is a DSN for one of the driver's databases. 227 The user and pass parameters are the other optional connection 228 parameters that will be provided to the DBI connect method. 229 230 Once you are sure that it is producing semi-sane data, you would 231 typically redirect the standard output to lib/DBD/Driver/TypeInfo.pm, 232 and then hand edit the result if necessary. 233 Do not forget to update your Makefile.PL and MANIFEST to include this as 234 an extra PM file that should be installed. 235 236 Please take a critical look at the data returned! 237 ODBC drivers vary dramatically in their quality. 238 239 The generator assumes that all the values are static and places these 240 values directly in the %info hash. 241 242 A possible implementation of DBD::Driver::type_info_all() may look like: 243 244 sub type_info_all { 245 my ($dbh) = @_; 246 require DBD::Driver::TypeInfo; 247 return [ @$DBD::Driver::TypeInfo::type_info_all ]; 248 } 249 250 Please replace Driver (or "<foo>") with the name of your driver. 251 Note that this stub function is generated for you by the write_typeinfo_pm 252 function, but you must manually transfer the code to Driver.pm. 253 254 =cut 255 256 257 # These two are used by fmt_value... 258 my %dbi_inv; 259 my %sql_type_inv; 260 261 #-DEBUGGING-# 262 #sub print_hash 263 #{ 264 # my ($name, %hash) = @_; 265 # print "Hash: $name\n"; 266 # foreach my $key (keys %hash) 267 # { 268 # print "$key => $hash{$key}\n"; 269 # } 270 #} 271 #-DEBUGGING-# 272 273 sub inverse_hash 274 { 275 my (%hash) = @_; 276 my (%inv); 277 foreach my $key (keys %hash) 278 { 279 my $val = $hash{$key}; 280 die "Double mapping for key value $val ($inv{$val}, $key)!" 281 if (defined $inv{$val}); 282 $inv{$val} = $key; 283 } 284 return %inv; 285 } 286 287 sub fmt_value 288 { 289 my ($num, $val) = @_; 290 if (!defined $val) 291 { 292 $val = "undef"; 293 } 294 elsif ($val !~ m/^[-+]?\d+$/) 295 { 296 # All the numbers in type_info_all are integers! 297 # Anything that isn't an integer is a string. 298 # Ensure that no double quotes screw things up. 299 $val =~ s/"/\\"/g if ($val =~ m/"/o); 300 $val = qq{"$val"}; 301 } 302 elsif ($dbi_inv{$num} =~ m/^(SQL_)?DATA_TYPE$/) 303 { 304 # All numeric... 305 $val = $sql_type_inv{$val} 306 if (defined $sql_type_inv{$val}); 307 } 308 return $val; 309 } 310 311 sub write_typeinfo_pm 312 { 313 my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV; 314 my $dbh = DBI->connect($dsn, $user, $pass, {AutoCommit=>1, RaiseError=>1}); 315 $driver = "<foo>" unless defined $driver; 316 317 print <<PERL; 318 319 # Transfer this to ${driver}.pm 320 321 # The type_info_all function was automatically generated by 322 # DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION. 323 324 package DBD::$driver}::db; # This line can be removed once transferred. 325 326 sub type_info_all 327 { 328 my (\$dbh) = \@_; 329 require DBD::$driver}::TypeInfo; 330 return [ \@\$DBD::$driver}::TypeInfo::type_info_all ]; 331 } 332 333 # Transfer this to lib/DBD/${driver}/TypeInfo.pm. 334 # Don't forget to add version and intellectual property control information. 335 336 # The \%type_info_all hash was automatically generated by 337 # DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION. 338 339 package DBD::$driver}::TypeInfo; 340 341 { 342 require Exporter; 343 require DynaLoader; 344 \@ISA = qw(Exporter DynaLoader); 345 \@EXPORT = qw(type_info_all); 346 use DBI qw(:sql_types); 347 348 PERL 349 350 # Generate SQL type name mapping hashes. 351 # See code fragment in DBI specification. 352 my %sql_type_map; 353 foreach (@{$DBI::EXPORT_TAGS{sql_types}}) 354 { 355 no strict 'refs'; 356 $sql_type_map{$_} = &{"DBI::$_"}(); 357 $sql_type_inv{$sql_type_map{$_}} = $_; 358 } 359 #-DEBUG-# print_hash("sql_type_map", %sql_type_map); 360 #-DEBUG-# print_hash("sql_type_inv", %sql_type_inv); 361 362 my %dbi_map = 363 ( 364 TYPE_NAME => 0, 365 DATA_TYPE => 1, 366 COLUMN_SIZE => 2, 367 LITERAL_PREFIX => 3, 368 LITERAL_SUFFIX => 4, 369 CREATE_PARAMS => 5, 370 NULLABLE => 6, 371 CASE_SENSITIVE => 7, 372 SEARCHABLE => 8, 373 UNSIGNED_ATTRIBUTE => 9, 374 FIXED_PREC_SCALE => 10, 375 AUTO_UNIQUE_VALUE => 11, 376 LOCAL_TYPE_NAME => 12, 377 MINIMUM_SCALE => 13, 378 MAXIMUM_SCALE => 14, 379 SQL_DATA_TYPE => 15, 380 SQL_DATETIME_SUB => 16, 381 NUM_PREC_RADIX => 17, 382 INTERVAL_PRECISION => 18, 383 ); 384 385 #-DEBUG-# print_hash("dbi_map", %dbi_map); 386 387 %dbi_inv = inverse_hash(%dbi_map); 388 389 #-DEBUG-# print_hash("dbi_inv", %dbi_inv); 390 391 my $maxlen = 0; 392 foreach my $key (keys %dbi_map) 393 { 394 $maxlen = length($key) if length($key) > $maxlen; 395 } 396 397 # Print the name/value mapping entry in the type_info_all array; 398 my $fmt = " \%-$maxlen}s => \%2d,\n"; 399 my $numkey = 0; 400 my $maxkey = 0; 401 print " \$type_info_all = [\n {\n"; 402 foreach my $i (sort { $a <=> $b } keys %dbi_inv) 403 { 404 printf($fmt, $dbi_inv{$i}, $i); 405 $numkey++; 406 $maxkey = $i; 407 } 408 print " },\n"; 409 410 print STDERR "### WARNING - Non-dense set of keys ($numkey keys, $maxkey max key)\n" 411 unless $numkey = $maxkey + 1; 412 413 my $h = $dbh->type_info_all; 414 my @tia = @$h; 415 my %odbc_map = map { uc $_ => $tia[0]->{$_} } keys %{$tia[0]}; 416 shift @tia; # Remove the mapping reference. 417 my $numtyp = $#tia; 418 419 #-DEBUG-# print_hash("odbc_map", %odbc_map); 420 421 # In theory, the key/number mapping sequence for %dbi_map 422 # should be the same as the one from the ODBC driver. However, to 423 # prevent the possibility of mismatches, and to deal with older 424 # missing attributes or unexpected new ones, we chase back through 425 # the %dbi_inv and %odbc_map hashes, generating @dbi_to_odbc 426 # to map our new key number to the old one. 427 # Report if @dbi_to_odbc is not an identity mapping. 428 my @dbi_to_odbc; 429 foreach my $num (sort { $a <=> $b } keys %dbi_inv) 430 { 431 # Find the name in %dbi_inv that matches this index number. 432 my $dbi_key = $dbi_inv{$num}; 433 #-DEBUG-# print "dbi_key = $dbi_key\n"; 434 #-DEBUG-# print "odbc_key = $odbc_map{$dbi_key}\n"; 435 # Find the index in %odbc_map that has this key. 436 $dbi_to_odbc[$num] = (defined $odbc_map{$dbi_key}) ? $odbc_map{$dbi_key} : undef; 437 } 438 439 # Determine the length of the longest formatted value in each field 440 my @len; 441 for (my $i = 0; $i <= $numtyp; $i++) 442 { 443 my @odbc_val = @{$tia[$i]}; 444 for (my $num = 0; $num <= $maxkey; $num++) 445 { 446 # Find the value of the entry in the @odbc_val array. 447 my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef; 448 $val = fmt_value($num, $val); 449 #-DEBUG-# print "val = $val\n"; 450 $val = "$val,"; 451 $len[$num] = length($val) if !defined $len[$num] || length($val) > $len[$num]; 452 } 453 } 454 455 # Generate format strings to left justify each string in maximum field width. 456 my @fmt; 457 for (my $i = 0; $i <= $maxkey; $i++) 458 { 459 $fmt[$i] = "%-$len[$i]s"; 460 #-DEBUG-# print "fmt[$i] = $fmt[$i]\n"; 461 } 462 463 # Format the data from type_info_all 464 for (my $i = 0; $i <= $numtyp; $i++) 465 { 466 my @odbc_val = @{$tia[$i]}; 467 print " [ "; 468 for (my $num = 0; $num <= $maxkey; $num++) 469 { 470 # Find the value of the entry in the @odbc_val array. 471 my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef; 472 $val = fmt_value($num, $val); 473 printf $fmt[$num], "$val,"; 474 } 475 print " ],\n"; 476 } 477 478 print " ];\n\n 1;\n}\n\n__END__\n"; 479 480 } 481 482 1; 483 484 __END__ 485 486 =head1 AUTHORS 487 488 Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>), 489 Jochen Wiedmann <joe@ispsoft.de>, 490 Steffen Goeldner <sgoeldner@cpan.org>, 491 and Tim Bunce <dbi-users@perl.org>. 492 493 =cut
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |