This is still far from complete, but I made minor
improvements:

 - convert_ado_to_odbc() handles the very special 'adArray'
 - convert_ado_to_odbc() handles temporal datatypes
 - column_info() provides a more complete mapping

For your demo table, column_info() returns:

 demo ID      4 Long        10        0              4        1 NO
 demo num1    4 Long        10        1          0   4        2 YES
 demo num2    5 Short        5        1          0   5        3 YES
 demo num3    6 Single       7        1          0   6        4 YES
 demo num4    8 Double      15        1          0   8        5 YES
 demo num5  -11                       1            -11        6 YES
 demo num6    2 Decimal     18     0  1          0   2        7 YES
 demo txt1   -9 VarChar     50 100    1             -9   100  8 YES
 demo txt2   -9 VarChar    255 510    1             -9   510  9 YES
 demo memo1 -10 LongText     0   0    1            -10     0 10 YES
 demo dt1    93                       1              9 3     11 YES
 demo cur1    2 Decimal     19        1          0   2       12 YES
 demo cur2    2 Decimal     19        1          0   2       13 YES
 demo cur3    2 Decimal     19        1          0   2       14 YES
 demo cur4    2 Decimal     19        1          0   2       15 YES
 demo cur5    2 Decimal     19        1          0   2       16 YES
 demo cur6    2 Decimal     19        1          0   2       17 YES
 demo cur7    2 Decimal     19        1          0   2       18 YES
 demo an2   -11                       1  GenGUID() -11       19 YES
 demo yn1    16              2        0             16       20 NO
 demo yn2    16              2        0             16       21 NO
 demo yn3    16              2        0             16       22 NO
 demo oo1    -4 LongBinary   0   0    1             -4     0 23 YES
 demo hl1   -10 LongText     0   0    1            -10     0 24 YES

Next, I'll try to find proper TYPE_NAME's. I think about restricting
SchemaProviderTypes by $AdoType, $IsLong, $IsFixed. This gives:

 1)  0 records, if the provider is buggy
 2)  1 record in most cases
 3) >1 records, e.g. for different max column sizes

Case 2) is trivial.
Case 1) may return NULL (undef) or an standard SQL name?
Case 3) should return the first type which has a large enough
        COLUMN_SIZE


Steffen
*** F:\tmp\DBD-ADO\lib\DBD\ADO.pm       Mon Nov 26 21:48:40 2001
--- W:\info\lang\perl\test\DBI\DBD\ADO.pm       Wed Dec 05 22:11:54 2001
***************
*** 95,100 ****
--- 95,101 ----
  my %connect_options;
  
  my $myado_types_supported = ();
+ my $myado_types_supported2 = ();
  
  
  
***************
*** 114,121 ****
        use constant DBPROPVAL_TC_NONE  => 0;
  
        use constant SQL_GUID                                                          
                                         => -11;
!       use constant SQL_BIGINT                                                        
                                 => - 6;
        use constant SQL_UNKNOWN_TYPE                                                  
                 =>   0;
        use constant SQL_BIT                          =>   14;
        use constant SQL_BIT_VARYING                  =>   15;
        use constant SQL_BOOLEAN                      =>   16;
--- 115,132 ----
        use constant DBPROPVAL_TC_NONE  => 0;
  
        use constant SQL_GUID                         =>  -11;
!       use constant SQL_WLONGVARCHAR                 =>  -10;
!       use constant SQL_WVARCHAR                     =>   -9;
!       use constant SQL_WCHAR                        =>   -8;
!       use constant SQL_BIT                          =>   -7;
!       use constant SQL_TINYINT                      =>   -6;
!       use constant SQL_BIGINT                       =>   -5;
!       use constant SQL_LONGVARBINARY                =>   -4;
!       use constant SQL_VARBINARY                    =>   -3;
!       use constant SQL_BINARY                       =>   -2;
!       use constant SQL_LONGVARCHAR                  =>   -1;
        use constant SQL_UNKNOWN_TYPE                 =>    0;
+ 
        use constant SQL_BIT                          =>   14;
        use constant SQL_BIT_VARYING                  =>   15;
        use constant SQL_BOOLEAN                      =>   16;
***************
*** 162,167 ****
--- 173,198 ----
            $VT_I4_BYREF = Win32::OLE::Variant::VT_I4()
                         | Win32::OLE::Variant::VT_BYREF();
  
+ 
+       $myado_types_supported2 = {
+                     # AdoType     IsLong IsFixed => SqlType
+         $ado_consts->{adBinary   } => { 0 => { 0 =>      SQL_VARBINARY
+                                              , 1 =>      SQL_BINARY        }
+                                       , 1 => { 0 =>      SQL_LONGVARBINARY
+                                              , 1 =>      SQL_UNKNOWN_TYPE  }}
+       , $ado_consts->{adChar     } => { 0 => { 0 => DBI::SQL_VARCHAR
+                                              , 1 => DBI::SQL_CHAR          }
+                                       , 1 => { 0 =>      SQL_LONGVARCHAR
+                                              , 1 =>      SQL_UNKNOWN_TYPE  }}
+       , $ado_consts->{adWChar    } => { 0 => { 0 =>      SQL_WVARCHAR
+                                              , 1 =>      SQL_WCHAR         }
+                                       , 1 => { 0 =>      SQL_WLONGVARCHAR
+                                              , 1 =>      SQL_UNKNOWN_TYPE  }}
+ #     , $ado_consts->{adVarBinary} =>
+ #     , $ado_consts->{adVarChar  } =>
+ #     , $ado_consts->{adVarWChar } =>
+       };
+ 
        $myado_types_supported = {
          $ado_consts->{adArray}                                                =>     
 SQL_ARRAY
        , $ado_consts->{adBigInt}                                               =>     
 SQL_BIGINT
***************
*** 171,180 ****
        , $ado_consts->{adChapter}                                      =>      
SQL_UNKNOWN_TYPE
        , $ado_consts->{adChar}                                                 => 
DBI::SQL_CHAR
        , $ado_consts->{adCurrency}                                     => 
DBI::SQL_NUMERIC
!       , $ado_consts->{adDate}                                                 => 
DBI::SQL_DATE
!       , $ado_consts->{adDBDate}                                               => 
DBI::SQL_DATE
!       , $ado_consts->{adDBTime}                                               => 
DBI::SQL_TIME
!       , $ado_consts->{adDBTimeStamp}                  => DBI::SQL_TIMESTAMP
        , $ado_consts->{adDecimal}                                      => 
DBI::SQL_DECIMAL
        , $ado_consts->{adDouble}                                               => 
DBI::SQL_DOUBLE
        , $ado_consts->{adEmpty}                                                =>     
 SQL_UNKNOWN_TYPE
--- 202,211 ----
        , $ado_consts->{adChapter}                                      =>      
SQL_UNKNOWN_TYPE
        , $ado_consts->{adChar}                                                 => 
DBI::SQL_CHAR
        , $ado_consts->{adCurrency}                                     => 
DBI::SQL_NUMERIC
!       , $ado_consts->{adDate}                                                 =>     
 SQL_TYPE_TIMESTAMP # XXX Not really!
!       , $ado_consts->{adDBDate}                                               =>     
 SQL_TYPE_DATE
!       , $ado_consts->{adDBTime}                                               =>     
 SQL_TYPE_TIME
!       , $ado_consts->{adDBTimeStamp}                  =>      SQL_TYPE_TIMESTAMP
        , $ado_consts->{adDecimal}                                      => 
DBI::SQL_DECIMAL
        , $ado_consts->{adDouble}                                               => 
DBI::SQL_DOUBLE
        , $ado_consts->{adEmpty}                                                =>     
 SQL_UNKNOWN_TYPE
***************
*** 754,759 ****
--- 785,853 ----
                $sth;
        }
  
+       sub column_info {
+               my( $dbh, @Criteria ) = @_;
+               my $Criteria = \@Criteria if @Criteria;
+               my $QueryType = 'adSchemaColumns';
+               my @Rows;
+               my $conn = $dbh->{ado_conn};
+               my $tmpCursorLocation = $conn->{CursorLocation};
+               $conn->{CursorLocation} = $ado_consts->{adUseClient};
+ 
+               my $RecSet = $conn->OpenSchema( $ado_consts->{$QueryType}, $Criteria );
+               my $lastError = DBD::ADO::errors($conn);
+               return DBI::set_err($dbh, $DBD::ADO::err,
+                       "Error occurred with call to OpenSchema ($QueryType): 
+$lastError")
+                               if $lastError;
+ 
+               $RecSet->{Sort} = 'TABLE_CATALOG, TABLE_SCHEMA, TABLE_NAME, 
+ORDINAL_POSITION';
+               $lastError = DBD::ADO::errors($conn);
+               return DBI::set_err($dbh, $DBD::ADO::err,
+                       "Error occurred defining sort order : $lastError")
+                               if $lastError;
+ 
+               while ( ! $RecSet->{EOF} ) {
+                       my @Fields;
+                       my $AdoType  = $RecSet->Fields('DATA_TYPE'   )->{Value};
+                       my $ColFlags = $RecSet->Fields('COLUMN_FLAGS')->{Value};
+                       my $IsLong   = ( $ColFlags & $ado_consts->{adFldLong } ) ? 1 : 
+0;
+                       my $IsFixed  = ( $ColFlags & $ado_consts->{adFldFixed} ) ? 1 : 
+0;
+                       my @SqlType  = DBD::ADO::db::convert_ado_to_odbc( $dbh, 
+$AdoType, $IsLong, $IsFixed );
+                       my $TypeInfo = $dbh->type_info( $SqlType[0] );
+                       my $TypeName = $TypeInfo ? $TypeInfo->{TYPE_NAME} : undef;
+                       my $IsNullable = $RecSet->Fields('IS_NULLABLE')->{Value} ? 
+'YES' : 'NO';
+ 
+                       $Fields[ 0] = $RecSet->Fields('TABLE_CATALOG'           
+)->{Value}; # TABLE_CAT
+                       $Fields[ 1] = $RecSet->Fields('TABLE_SCHEMA'            
+)->{Value}; # TABLE_SCHEM
+                       $Fields[ 2] = $RecSet->Fields('TABLE_NAME'              
+)->{Value}; # TABLE_NAME
+                       $Fields[ 3] = $RecSet->Fields('COLUMN_NAME'             
+)->{Value}; # COLUMN_NAME
+                       $Fields[ 4] = $SqlType[0]                                      
+   ; # DATA_TYPE !!!
+                       $Fields[ 5] = $TypeName                                        
+   ; # TYPE_NAME !!!
+                       $Fields[ 6] = $RecSet->Fields('NUMERIC_PRECISION'       
+)->{Value}
+                                  || 
+$RecSet->Fields('CHARACTER_MAXIMUM_LENGTH')->{Value}; # COLUMN_SIZE !!! MAX for *LONG*
+                       $Fields[ 7] = $RecSet->Fields('CHARACTER_OCTET_LENGTH'  
+)->{Value}; # BUFFER_LENGTH !!! MAX for *LONG*, ... (e.g. num)
+                       $Fields[ 8] = $RecSet->Fields('NUMERIC_SCALE'           
+)->{Value}; # DECIMAL_DIGITS ???
+                       $Fields[ 9] = undef                                            
+   ; # NUM_PREC_RADIX !!!
+                       $Fields[10] = $RecSet->Fields('IS_NULLABLE'             
+)->{Value}; # NULLABLE !!!
+                       $Fields[11] = $RecSet->Fields('DESCRIPTION'             
+)->{Value}; # REMARKS
+                       $Fields[12] = $RecSet->Fields('COLUMN_DEFAULT'          
+)->{Value}; # COLUMN_DEF
+                       $Fields[13] = $SqlType[1]                                      
+   ; # SQL_DATA_TYPE !!!
+                       $Fields[14] = $SqlType[2]                                      
+   ; # SQL_DATETIME_SUB !!!
+                       $Fields[15] = $RecSet->Fields('CHARACTER_OCTET_LENGTH'  
+)->{Value}; # CHAR_OCTET_LENGTH !!! MAX for *LONG*
+                       $Fields[16] = $RecSet->Fields('ORDINAL_POSITION'        
+)->{Value}; # ORDINAL_POSITION
+                       $Fields[17] = $IsNullable                                      
+   ; # IS_NULLABLE !!!
+ 
+                       push( @Rows, \@Fields );
+                       $RecSet->MoveNext;
+               }
+               $RecSet->Close; undef $RecSet;
+               $conn->{CursorLocation} = $tmpCursorLocation;
+ 
+               DBI->connect('dbi:Sponge:','','', { RaiseError => 1 })->prepare(
+                       $QueryType, { rows => \@Rows, NAME =>
+                       [ qw( TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME DATA_TYPE 
+TYPE_NAME COLUMN_SIZE BUFFER_LENGTH DECIMAL_DIGITS NUM_PREC_RADIX NULLABLE REMARKS 
+COLUMN_DEF SQL_DATA_TYPE SQL_DATETIME_SUB CHAR_OCTET_LENGTH ORDINAL_POSITION 
+IS_NULLABLE ) ]});
+       }
+ 
        sub primary_key_info {
                my( $dbh, @Criteria ) = @_;
                my $QueryType = 'adSchemaPrimaryKeys';
***************
*** 1011,1030 ****
  
        # Attempt to convert an ADO data type into an ODBC/SQL data type.
        sub convert_ado_to_odbc {
!               my ($dbh, $attrib) = @_;
  
                        return $dbh->DBI::set_err( -1,
                                "convert_ado_to_odbc: call without any attributes.")
!                       unless $attrib;
  
                        unless( $ado_types_supported ) {
                                &_determine_type_support($dbh);
                        }
!                       if ( exists $myado_types_supported->{$attrib} ) {
!                               return $myado_types_supported->{$attrib};
                        }
  
!               return $attrib;
        }
  
        sub OpenSchema {
--- 1105,1147 ----
  
        # Attempt to convert an ADO data type into an ODBC/SQL data type.
        sub convert_ado_to_odbc {
!               my ($dbh, $AdoType, $IsLong, $IsFixed ) = @_;
  
                return $dbh->DBI::set_err( -1,
                        "convert_ado_to_odbc: call without any attributes.")
!                       unless $AdoType;
  
                unless( $ado_types_supported ) {
                        &_determine_type_support($dbh);
                }
! 
!               my $SqlType = 0;
! 
!               if ( $AdoType & $ado_consts->{adArray} ) {
!                       $SqlType = 50;  # XXX DBI::SQL_ARRAY();
!               }
!               elsif ( exists $myado_types_supported2->{$AdoType}{$IsLong}{$IsFixed} 
) {
!                       $SqlType = 
$myado_types_supported2->{$AdoType}{$IsLong}{$IsFixed};
!               }
!               elsif ( exists $myado_types_supported->{$AdoType} ) {
!                       $SqlType = $myado_types_supported->{$AdoType};
                }
  
!               if ( wantarray ) {  # DATA_TYPE, SQL_DATA_TYPE, SQL_DATETIME_SUB
!                       my @a = ( $SqlType );
! 
!                       if ( 90 < $SqlType && $SqlType < 100 ) {  # SQL_DATETIME
!                               push @a, 9, $SqlType - 90;
!                       }
!                       elsif ( 100 < $SqlType && $SqlType < 120 ) {  # SQL_INTERVAL
!                               push @a, 10, $SqlType - 100;
!                       }
!                       else {
!                               push @a, $SqlType, undef;
!                       }
!                       return @a;
!               }
!               return $SqlType;
        }
  
        sub OpenSchema {

Reply via email to