summaryrefslogtreecommitdiff
path: root/lib/DBI/DBD/Metadata.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/DBI/DBD/Metadata.pm')
-rw-r--r--lib/DBI/DBD/Metadata.pm493
1 files changed, 493 insertions, 0 deletions
diff --git a/lib/DBI/DBD/Metadata.pm b/lib/DBI/DBD/Metadata.pm
new file mode 100644
index 0000000..75f5b89
--- /dev/null
+++ b/lib/DBI/DBD/Metadata.pm
@@ -0,0 +1,493 @@
+package DBI::DBD::Metadata;
+
+# $Id: Metadata.pm 14213 2010-06-30 19:29:18Z mjevans $
+#
+# Copyright (c) 1997-2003 Jonathan Leffler, Jochen Wiedmann,
+# Steffen Goeldner and Tim Bunce
+#
+# You may distribute under the terms of either the GNU General Public
+# License or the Artistic License, as specified in the Perl README file.
+
+use Exporter ();
+use Carp;
+
+use DBI;
+use DBI::Const::GetInfoType qw(%GetInfoType);
+
+# Perl 5.005_03 does not recognize 'our'
+@ISA = qw(Exporter);
+@EXPORT = qw(write_getinfo_pm write_typeinfo_pm);
+
+$VERSION = sprintf("2.%06d", q$Revision: 14213 $ =~ /(\d+)/o);
+
+
+use strict;
+
+=head1 NAME
+
+DBI::DBD::Metadata - Generate the code and data for some DBI metadata methods
+
+=head1 SYNOPSIS
+
+The idea is to extract metadata information from a good quality
+ODBC driver and use it to generate code and data to use in your own
+DBI driver for the same database.
+
+To generate code to support the get_info method:
+
+ perl -MDBI::DBD::Metadata -e "write_getinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')"
+
+ perl -MDBI::DBD::Metadata -e write_getinfo_pm dbi:ODBC:foo_db username password Driver
+
+To generate code to support the type_info method:
+
+ perl -MDBI::DBD::Metadata -e "write_typeinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')"
+
+ perl -MDBI::DBD::Metadata -e write_typeinfo_pm dbi:ODBC:dsn-name user pass Driver
+
+Where C<dbi:ODBC:dsn-name> is the connection to use to extract the
+data, and C<Driver> is the name of the driver you want the code
+generated for (the driver name gets embedded into the output in
+numerous places).
+
+=head1 Generating a GetInfo package for a driver
+
+The C<write_getinfo_pm> in the DBI::DBD::Metadata module generates a
+DBD::Driver::GetInfo package on standard output.
+
+This method generates a DBD::Driver::GetInfo package from the data
+source you specified in the parameter list or in the environment
+variable DBI_DSN.
+DBD::Driver::GetInfo should help a DBD author implement the DBI
+get_info() method.
+Because you are just creating this package, it is very unlikely that
+DBD::Driver already provides a good implementation for get_info().
+Thus you will probably connect via DBD::ODBC.
+
+Once you are sure that it is producing reasonably sane data, you should
+typically redirect the standard output to lib/DBD/Driver/GetInfo.pm, and
+then hand edit the result.
+Do not forget to update your Makefile.PL and MANIFEST to include this as
+an extra PM file that should be installed.
+
+If you connect via DBD::ODBC, you should use version 0.38 or greater;
+
+Please take a critical look at the data returned!
+ODBC drivers vary dramatically in their quality.
+
+The generator assumes that most values are static and places these
+values directly in the %info hash.
+A few examples show the use of CODE references and the implementation
+via subroutines.
+It is very likely that you will have to write additional subroutines for
+values depending on the session state or server version, e.g.
+SQL_DBMS_VER.
+
+A possible implementation of DBD::Driver::db::get_info() may look like:
+
+ sub get_info {
+ my($dbh, $info_type) = @_;
+ require DBD::Driver::GetInfo;
+ my $v = $DBD::Driver::GetInfo::info{int($info_type)};
+ $v = $v->($dbh) if ref $v eq 'CODE';
+ return $v;
+ }
+
+Please replace Driver (or "<foo>") with the name of your driver.
+Note that this stub function is generated for you by write_getinfo_pm
+function, but you must manually transfer the code to Driver.pm.
+
+=cut
+
+sub write_getinfo_pm
+{
+ my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV;
+ my $dbh = DBI->connect($dsn, $user, $pass, {RaiseError=>1});
+ $driver = "<foo>" unless defined $driver;
+
+ print <<PERL;
+
+# Transfer this to ${driver}.pm
+
+# The get_info function was automatically generated by
+# DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION.
+
+package DBD::${driver}::db; # This line can be removed once transferred.
+
+ sub get_info {
+ my(\$dbh, \$info_type) = \@_;
+ require DBD::${driver}::GetInfo;
+ my \$v = \$DBD::${driver}::GetInfo::info{int(\$info_type)};
+ \$v = \$v->(\$dbh) if ref \$v eq 'CODE';
+ return \$v;
+ }
+
+# Transfer this to lib/DBD/${driver}/GetInfo.pm
+
+# The \%info hash was automatically generated by
+# DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION.
+
+package DBD::${driver}::GetInfo;
+
+use strict;
+use DBD::${driver};
+
+# Beware: not officially documented interfaces...
+# use DBI::Const::GetInfoType qw(\%GetInfoType);
+# use DBI::Const::GetInfoReturn qw(\%GetInfoReturnTypes \%GetInfoReturnValues);
+
+my \$sql_driver = '${driver}';
+my \$sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.#####
+my \$sql_driver_ver = sprintf \$sql_ver_fmt, split (/\\./, \$DBD::${driver}::VERSION);
+PERL
+
+my $kw_map = 0;
+{
+# Informix CLI (ODBC) v3.81.0000 does not return a list of keywords.
+ local $\ = "\n";
+ local $, = "\n";
+ my ($kw) = $dbh->get_info($GetInfoType{SQL_KEYWORDS});
+ if ($kw)
+ {
+ print "\nmy \@Keywords = qw(\n";
+ print sort split /,/, $kw;
+ print ");\n\n";
+ print "sub sql_keywords {\n";
+ print q% return join ',', @Keywords;%;
+ print "\n}\n\n";
+ $kw_map = 1;
+ }
+}
+
+ print <<'PERL';
+
+sub sql_data_source_name {
+ my $dbh = shift;
+ return "dbi:$sql_driver:" . $dbh->{Name};
+}
+
+sub sql_user_name {
+ my $dbh = shift;
+ # CURRENT_USER is a non-standard attribute, probably undef
+ # Username is a standard DBI attribute
+ return $dbh->{CURRENT_USER} || $dbh->{Username};
+}
+
+PERL
+
+ print "\nour \%info = (\n";
+ foreach my $key (sort keys %GetInfoType)
+ {
+ my $num = $GetInfoType{$key};
+ my $val = eval { $dbh->get_info($num); };
+ if ($key eq 'SQL_DATA_SOURCE_NAME') {
+ $val = '\&sql_data_source_name';
+ }
+ elsif ($key eq 'SQL_KEYWORDS') {
+ $val = ($kw_map) ? '\&sql_keywords' : 'undef';
+ }
+ elsif ($key eq 'SQL_DRIVER_NAME') {
+ $val = "\$INC{'DBD/$driver.pm'}";
+ }
+ elsif ($key eq 'SQL_DRIVER_VER') {
+ $val = '$sql_driver_ver';
+ }
+ elsif ($key eq 'SQL_USER_NAME') {
+ $val = '\&sql_user_name';
+ }
+ elsif (not defined $val) {
+ $val = 'undef';
+ }
+ elsif ($val eq '') {
+ $val = "''";
+ }
+ elsif ($val =~ /\D/) {
+ $val =~ s/\\/\\\\/g;
+ $val =~ s/'/\\'/g;
+ $val = "'$val'";
+ }
+ printf "%s %5d => %-30s # %s\n", (($val eq 'undef') ? '#' : ' '), $num, "$val,", $key;
+ }
+ print ");\n\n1;\n\n__END__\n";
+}
+
+
+
+=head1 Generating a TypeInfo package for a driver
+
+The C<write_typeinfo_pm> function in the DBI::DBD::Metadata module generates
+on standard output the data needed for a driver's type_info_all method.
+It also provides default implementations of the type_info_all
+method for inclusion in the driver's main implementation file.
+
+The driver parameter is the name of the driver for which the methods
+will be generated; for the sake of examples, this will be "Driver".
+Typically, the dsn parameter will be of the form "dbi:ODBC:odbc_dsn",
+where the odbc_dsn is a DSN for one of the driver's databases.
+The user and pass parameters are the other optional connection
+parameters that will be provided to the DBI connect method.
+
+Once you are sure that it is producing reasonably sane data, you should
+typically redirect the standard output to lib/DBD/Driver/TypeInfo.pm,
+and then hand edit the result if necessary.
+Do not forget to update your Makefile.PL and MANIFEST to include this as
+an extra PM file that should be installed.
+
+Please take a critical look at the data returned!
+ODBC drivers vary dramatically in their quality.
+
+The generator assumes that all the values are static and places these
+values directly in the %info hash.
+
+A possible implementation of DBD::Driver::type_info_all() may look like:
+
+ sub type_info_all {
+ my ($dbh) = @_;
+ require DBD::Driver::TypeInfo;
+ return [ @$DBD::Driver::TypeInfo::type_info_all ];
+ }
+
+Please replace Driver (or "<foo>") with the name of your driver.
+Note that this stub function is generated for you by the write_typeinfo_pm
+function, but you must manually transfer the code to Driver.pm.
+
+=cut
+
+
+# These two are used by fmt_value...
+my %dbi_inv;
+my %sql_type_inv;
+
+#-DEBUGGING-#
+#sub print_hash
+#{
+# my ($name, %hash) = @_;
+# print "Hash: $name\n";
+# foreach my $key (keys %hash)
+# {
+# print "$key => $hash{$key}\n";
+# }
+#}
+#-DEBUGGING-#
+
+sub inverse_hash
+{
+ my (%hash) = @_;
+ my (%inv);
+ foreach my $key (keys %hash)
+ {
+ my $val = $hash{$key};
+ die "Double mapping for key value $val ($inv{$val}, $key)!"
+ if (defined $inv{$val});
+ $inv{$val} = $key;
+ }
+ return %inv;
+}
+
+sub fmt_value
+{
+ my ($num, $val) = @_;
+ if (!defined $val)
+ {
+ $val = "undef";
+ }
+ elsif ($val !~ m/^[-+]?\d+$/)
+ {
+ # All the numbers in type_info_all are integers!
+ # Anything that isn't an integer is a string.
+ # Ensure that no double quotes screw things up.
+ $val =~ s/"/\\"/g if ($val =~ m/"/o);
+ $val = qq{"$val"};
+ }
+ elsif ($dbi_inv{$num} =~ m/^(SQL_)?DATA_TYPE$/)
+ {
+ # All numeric...
+ $val = $sql_type_inv{$val}
+ if (defined $sql_type_inv{$val});
+ }
+ return $val;
+}
+
+sub write_typeinfo_pm
+{
+ my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV;
+ my $dbh = DBI->connect($dsn, $user, $pass, {AutoCommit=>1, RaiseError=>1});
+ $driver = "<foo>" unless defined $driver;
+
+ print <<PERL;
+
+# Transfer this to ${driver}.pm
+
+# The type_info_all function was automatically generated by
+# DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION.
+
+package DBD::${driver}::db; # This line can be removed once transferred.
+
+ sub type_info_all
+ {
+ my (\$dbh) = \@_;
+ require DBD::${driver}::TypeInfo;
+ return [ \@\$DBD::${driver}::TypeInfo::type_info_all ];
+ }
+
+# Transfer this to lib/DBD/${driver}/TypeInfo.pm.
+# Don't forget to add version and intellectual property control information.
+
+# The \%type_info_all hash was automatically generated by
+# DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION.
+
+package DBD::${driver}::TypeInfo;
+
+{
+ require Exporter;
+ require DynaLoader;
+ \@ISA = qw(Exporter DynaLoader);
+ \@EXPORT = qw(type_info_all);
+ use DBI qw(:sql_types);
+
+PERL
+
+ # Generate SQL type name mapping hashes.
+ # See code fragment in DBI specification.
+ my %sql_type_map;
+ foreach (@{$DBI::EXPORT_TAGS{sql_types}})
+ {
+ no strict 'refs';
+ $sql_type_map{$_} = &{"DBI::$_"}();
+ $sql_type_inv{$sql_type_map{$_}} = $_;
+ }
+ #-DEBUG-# print_hash("sql_type_map", %sql_type_map);
+ #-DEBUG-# print_hash("sql_type_inv", %sql_type_inv);
+
+ my %dbi_map =
+ (
+ TYPE_NAME => 0,
+ DATA_TYPE => 1,
+ COLUMN_SIZE => 2,
+ LITERAL_PREFIX => 3,
+ LITERAL_SUFFIX => 4,
+ CREATE_PARAMS => 5,
+ NULLABLE => 6,
+ CASE_SENSITIVE => 7,
+ SEARCHABLE => 8,
+ UNSIGNED_ATTRIBUTE => 9,
+ FIXED_PREC_SCALE => 10,
+ AUTO_UNIQUE_VALUE => 11,
+ LOCAL_TYPE_NAME => 12,
+ MINIMUM_SCALE => 13,
+ MAXIMUM_SCALE => 14,
+ SQL_DATA_TYPE => 15,
+ SQL_DATETIME_SUB => 16,
+ NUM_PREC_RADIX => 17,
+ INTERVAL_PRECISION => 18,
+ );
+
+ #-DEBUG-# print_hash("dbi_map", %dbi_map);
+
+ %dbi_inv = inverse_hash(%dbi_map);
+
+ #-DEBUG-# print_hash("dbi_inv", %dbi_inv);
+
+ my $maxlen = 0;
+ foreach my $key (keys %dbi_map)
+ {
+ $maxlen = length($key) if length($key) > $maxlen;
+ }
+
+ # Print the name/value mapping entry in the type_info_all array;
+ my $fmt = " \%-${maxlen}s => \%2d,\n";
+ my $numkey = 0;
+ my $maxkey = 0;
+ print " \$type_info_all = [\n {\n";
+ foreach my $i (sort { $a <=> $b } keys %dbi_inv)
+ {
+ printf($fmt, $dbi_inv{$i}, $i);
+ $numkey++;
+ $maxkey = $i;
+ }
+ print " },\n";
+
+ print STDERR "### WARNING - Non-dense set of keys ($numkey keys, $maxkey max key)\n"
+ unless $numkey = $maxkey + 1;
+
+ my $h = $dbh->type_info_all;
+ my @tia = @$h;
+ my %odbc_map = map { uc $_ => $tia[0]->{$_} } keys %{$tia[0]};
+ shift @tia; # Remove the mapping reference.
+ my $numtyp = $#tia;
+
+ #-DEBUG-# print_hash("odbc_map", %odbc_map);
+
+ # In theory, the key/number mapping sequence for %dbi_map
+ # should be the same as the one from the ODBC driver. However, to
+ # prevent the possibility of mismatches, and to deal with older
+ # missing attributes or unexpected new ones, we chase back through
+ # the %dbi_inv and %odbc_map hashes, generating @dbi_to_odbc
+ # to map our new key number to the old one.
+ # Report if @dbi_to_odbc is not an identity mapping.
+ my @dbi_to_odbc;
+ foreach my $num (sort { $a <=> $b } keys %dbi_inv)
+ {
+ # Find the name in %dbi_inv that matches this index number.
+ my $dbi_key = $dbi_inv{$num};
+ #-DEBUG-# print "dbi_key = $dbi_key\n";
+ #-DEBUG-# print "odbc_key = $odbc_map{$dbi_key}\n";
+ # Find the index in %odbc_map that has this key.
+ $dbi_to_odbc[$num] = (defined $odbc_map{$dbi_key}) ? $odbc_map{$dbi_key} : undef;
+ }
+
+ # Determine the length of the longest formatted value in each field
+ my @len;
+ for (my $i = 0; $i <= $numtyp; $i++)
+ {
+ my @odbc_val = @{$tia[$i]};
+ for (my $num = 0; $num <= $maxkey; $num++)
+ {
+ # Find the value of the entry in the @odbc_val array.
+ my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef;
+ $val = fmt_value($num, $val);
+ #-DEBUG-# print "val = $val\n";
+ $val = "$val,";
+ $len[$num] = length($val) if !defined $len[$num] || length($val) > $len[$num];
+ }
+ }
+
+ # Generate format strings to left justify each string in maximum field width.
+ my @fmt;
+ for (my $i = 0; $i <= $maxkey; $i++)
+ {
+ $fmt[$i] = "%-$len[$i]s";
+ #-DEBUG-# print "fmt[$i] = $fmt[$i]\n";
+ }
+
+ # Format the data from type_info_all
+ for (my $i = 0; $i <= $numtyp; $i++)
+ {
+ my @odbc_val = @{$tia[$i]};
+ print " [ ";
+ for (my $num = 0; $num <= $maxkey; $num++)
+ {
+ # Find the value of the entry in the @odbc_val array.
+ my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef;
+ $val = fmt_value($num, $val);
+ printf $fmt[$num], "$val,";
+ }
+ print " ],\n";
+ }
+
+ print " ];\n\n 1;\n}\n\n__END__\n";
+
+}
+
+1;
+
+__END__
+
+=head1 AUTHORS
+
+Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>),
+Jochen Wiedmann <joe@ispsoft.de>,
+Steffen Goeldner <sgoeldner@cpan.org>,
+and Tim Bunce <dbi-users@perl.org>.
+
+=cut
View Lorry Controller Status