Thanks Steffen, I've been very busy ... hopefully I can get a new
DBD::ADO release out soon.
Tom
On Mon, Mar 04, 2002 at 04:28:08PM +0100, Steffen Goeldner wrote:
> Steffen Goeldner wrote:
> >
> > Tim Bunce wrote:
> > >
> > > On Fri, Feb 08, 2002 at 03:16:38PM +0100, Steffen Goeldner wrote:
> >
> > > >
> > > > Ok. Or, I'm thinking about a method ado_schema_dbinfo_literal(), caching
> > > > all data of the adSchemaDBInfoLiterals pseudo-table, ...
> > > > Attached are some results for the MSDAORA and Jet Provider.
> > >
> > > Seems like a good idea.
> >
> > Fine! Here a code snippet:
> >
> > [...]
>
> And here is the patch:
> diff -Nrc DBD-ADO-2.4.02-orig/lib/DBD/ADO/GetInfo.pm
>DBD-ADO-2.4.02/lib/DBD/ADO/GetInfo.pm
> *** DBD-ADO-2.4.02-orig/lib/DBD/ADO/GetInfo.pm Thu Jan 01 01:00:00 1970
> --- DBD-ADO-2.4.02/lib/DBD/ADO/GetInfo.pm Fri Feb 08 22:31:11 2002
> ***************
> *** 0 ****
> --- 1,64 ----
> + package DBD::ADO::GetInfo;
> +
> + use DBD::ADO();
> +
> + my $fmt = '%02d.%02d.%1d%1d%1d%1d'; # ODBC version string: ##.##.#####
> +
> + my $sql_driver_ver = sprintf $fmt, split(/[\._]/, $DBD::ADO::VERSION);
> +
> + sub sql_catalog_name_separator {
> + my $dbh = shift;
> + DBD::ADO::db::ado_schema_dbinfo_literal($dbh,'CATALOG_SEPARATOR') ||'.';
> + }
> + sub sql_concat_null_behavior {
> + { 1 => 0 # SQL_CB_NULL
> + , 2 => 1 # SQL_CB_NON_NULL
> + }->{$_[0]->{ado_conn}->Properties->{'NULL Concatenation Behavior'}{Value}};
> + }
> + sub sql_identifier_case {
> + { 1 => 1 # SQL_IC_UPPER
> + , 2 => 2 # SQL_IC_LOWER
> + , 4 => 3 # SQL_IC_SENSITIVE
> + , 8 => 4 # SQL_IC_MIXED
> + }->{$_[0]->{ado_conn}->Properties->{'Identifier Case Sensitivity'}{Value}};
> + }
> + sub sql_identifier_quote_char {
> + my $dbh = shift;
> + DBD::ADO::db::ado_schema_dbinfo_literal($dbh,'QUOTE') ||
> + DBD::ADO::db::ado_schema_dbinfo_literal($dbh,'QUOTE_PREFIX') ||'"';
> + }
> + sub sql_keywords {
> + my $dbh = shift;
> + my $sth = $dbh->func('adSchemaDBInfoKeywords','OpenSchema');
> + my @Keywords = ();
> + while ( my $row = $sth->fetch ) {
> + push @Keywords, $row->[0];
> + }
> + return join ',', @Keywords;
> + }
> +
> + %info = (
> + 41 => \&sql_catalog_name_separator # SQL_CATALOG_NAME_SEPARATOR
> + , 22 => \&sql_concat_null_behavior # SQL_CONCAT_NULL_BEHAVIOR
> + , 6 => $INC{'DBD/ADO.pm'} # SQL_DRIVER_NAME # XXX
> + , 7 => $sql_driver_ver # SQL_DRIVER_VER # XXX
> + , 28 => \&sql_identifier_case # SQL_IDENTIFIER_CASE
> + , 29 => \&sql_identifier_quote_char # SQL_IDENTIFIER_QUOTE_CHAR
> + , 89 => \&sql_keywords # SQL_KEYWORDS
> + );
> +
> + %odbc2ado = (
> + 114 => 'Catalog Location' # SQL_CATALOG_LOCATION
> + , 42 => 'Catalog Term' # SQL_CATALOG_TERM
> + , 2 => 'Data Source Name' # SQL_DATA_SOURCE_NAME
> + , 17 => 'DBMS Name' # SQL_DBMS_NAME
> + , 18 => 'DBMS Version' # SQL_DBMS_VERSION
> + # 6 => 'Provider Name' # SQL_DRIVER_NAME # XXX
> + # 7 => 'Provider Version' # SQL_DRIVER_VER # XXX
> + , 40 => 'Procedure Term' # SQL_PROCEDURE_TERM
> + , 39 => 'Schema Term' # SQL_SCHEMA_TERM
> + , 45 => 'Table Term' # SQL_TABLE_TERM
> + , 47 => 'User Name' # SQL_USER_NAME
> + );
> +
> + 1;
> diff -Nrc DBD-ADO-2.4.02-orig/lib/DBD/ADO.pm DBD-ADO-2.4.02/lib/DBD/ADO.pm
> *** DBD-ADO-2.4.02-orig/lib/DBD/ADO.pm Thu Dec 13 01:17:30 2001
> --- DBD-ADO-2.4.02/lib/DBD/ADO.pm Sat Mar 02 20:55:50 2002
> ***************
> *** 754,759 ****
> --- 754,792 ----
> $sth;
> }
>
> + sub get_info {
> + my($dbh, $info_type) = @_;
> + $info_type = int($info_type);
> + require DBD::ADO::GetInfo;
> + if ( exists $DBD::ADO::GetInfo::odbc2ado{$info_type} ) {
> + return
>$dbh->{ado_conn}->Properties->{$DBD::ADO::GetInfo::odbc2ado{$info_type}}{Value};
> + }
> + my $v = $DBD::ADO::GetInfo::info{$info_type};
> + if (ref $v eq 'CODE') {
> + my $get_info_cache = $dbh->{dbd_get_info_cache} ||= {};
> + return $get_info_cache->{$info_type} if exists
>$get_info_cache->{$info_type};
> + $v = $v->($dbh);
> + return $$v if ref $v eq 'SCALAR'; # don't cache!
> + $get_info_cache->{$info_type} = $v;
> + }
> + return $v;
> + }
> +
> + sub ado_schema_dbinfo_literal {
> + my($dbh, $literal_name) = @_;
> + my $cache = $dbh->{ado_schema_dbinfo_literal_cache};
> + unless ( defined $cache ) {
> + $dbh->trace_msg("-> ado_schema_dbinfo_literal: filling
>cache\n");
> + $cache = $dbh->{ado_schema_dbinfo_literal_cache} = {};
> + my $sth = $dbh->func('adSchemaDBInfoLiterals','OpenSchema');
> + while ( my $row = $sth->fetch ) {
> + $cache->{$row->[0]} = [ @$row ];
> + }
> + }
> + my $row = $cache->{$literal_name};
> + return $row->[1] unless wantarray; # literal value
> + return @$row;
> + }
>
> sub table_info {
> my($dbh, $attribs) = @_;
--
Thomas A. Lowery
See DBI/FAQ http://tlowery.hypermart.net
_________________________________________________________
Do You Yahoo!?
Get your free @yahoo.com address at http://mail.yahoo.com
