Re: DBD::ADO: get_info()

[Steffen Goeldner]

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) = @_;