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 {