Steffen Goeldner wrote:
>
> 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
>
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| GUID| | | ||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| DateTime| | | ||1|| | 9|3| |11|YES
||demo| cur1| 2| Currency| 19| | ||1|| 0| 2| | |12|YES
||demo| cur2| 2| Currency| 19| | ||1|| 0| 2| | |13|YES
||demo| cur3| 2| Currency| 19| | ||1|| 0| 2| | |14|YES
||demo| cur4| 2| Currency| 19| | ||1|| 0| 2| | |15|YES
||demo| cur5| 2| Currency| 19| | ||1|| 0| 2| | |16|YES
||demo| cur6| 2| Currency| 19| | ||1|| 0| 2| | |17|YES
||demo| cur7| 2| Currency| 19| | ||1|| 0| 2| | |18|YES
||demo| an2|-11| GUID| | | ||1||GenGUID()|-11| | |19|YES
||demo| yn1| 16| Bit| 2| | ||0|| | 16| | |20| NO
||demo| yn2| 16| Bit| 2| | ||0|| | 16| | |21| NO
||demo| yn3| 16| Bit| 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
And for this table:
create table demo3
(
cShort Short
, cLong Long
, cSingle Single
, cDouble Double
, cCurrency Currency
, cDateTime DateTime
, cBit Bit
, cByte Byte
, cGUID GUID
, cBigBinary BigBinary
, cLongBinary LongBinary
, cVarBinary VarBinary (20)
, cLongText LongText
, cVarChar VarChar (10)
, cDecimal Decimal (11,2)
)
column_info() returns:
||demo3| cShort| 5| Short| 5| | ||1||| 5| | | 1|YES
||demo3| cLong| 4| Long| 10| | ||1||| 4| | | 2|YES
||demo3| cSingle| 6| Single| 7| | ||1||| 6| | | 3|YES
||demo3| cDouble| 8| Double| 15| | ||1||| 8| | | 4|YES
||demo3| cCurrency| 2| Currency| 19| | ||1||| 2| | | 5|YES
||demo3| cDateTime| 93| DateTime| | | ||1||| 9|3| | 6|YES
||demo3| cBit| 16| Bit| 2| | ||0||| 16| | | 7| NO
||demo3| cByte| 0| Byte| 3| | ||1||| 0| | | 8|YES
||demo3| cGUID|-11| GUID| | | ||1|||-11| | | 9|YES
||demo3| cBigBinary| -3| BigBinary|4000|4000| ||1||| -3| |4000|10|YES
||demo3|cLongBinary| -4|LongBinary| 0| 0| ||1||| -4| | 0|11|YES
||demo3| cVarBinary| -3| VarBinary| 20| 20| ||1||| -3| | 20|12|YES
||demo3| cLongText|-10| LongText| 0| 0| ||1|||-10| | 0|13|YES
||demo3| cVarChar| -9| VarChar| 10| 20| ||1||| -9| | 20|14|YES
||demo3| cDecimal| 2| Decimal| 11| |2||1||| 2| | |15|YES
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 Sat Dec 08 21:55:57 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,862 ----
$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, $IsFixed, $IsLong );
+ # my $TypeInfo = $dbh->type_info( $SqlType[0] );
+ # my $TypeName = $TypeInfo ? $TypeInfo->{TYPE_NAME} : undef;
+ my $TypeName;
+ my $IsNullable = $RecSet->Fields('IS_NULLABLE')->{Value} ?
+'YES' : 'NO';
+ my $ColSize = $RecSet->Fields('NUMERIC_PRECISION'
+)->{Value}
+ ||
+$RecSet->Fields('CHARACTER_MAXIMUM_LENGTH')->{Value};
+ my $ado_tis = DBD::ADO::db::_ado_get_type_info_for( $dbh,
+$AdoType, $IsFixed, $IsLong );
+ # print '***', $AdoType, $IsFixed, $IsLong, ' => ', $ColSize,
+$RecSet->Fields('COLUMN_NAME')->{Value};
+ for my $ti ( sort { $a->{COLUMN_SIZE} <=> $b->{COLUMN_SIZE} }
+@$ado_tis )
+ {
+ $TypeName = $ti->{TYPE_NAME};
+ # print '***', $AdoType, $IsFixed, $IsLong, ' => ',
+$ti->{TYPE_NAME}, $ti->{COLUMN_SIZE}, $ColSize,
+$RecSet->Fields('COLUMN_NAME')->{Value};
+ last if $ti->{COLUMN_SIZE} >= $ColSize;
+ }
+ $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] = $ColSize
+ ; # 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';
***************
*** 1009,1030 ****
return \@prov_type_return;
}
# 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 {
--- 1112,1168 ----
return \@prov_type_return;
}
+ sub _ado_get_type_info_for {
+ my ($dbh, $AdoType, $IsFixed, $IsLong ) = @_;
+
+ unless( $dbh->{ado_type_info_hash} ) {
+ my $sth = $dbh->func('adSchemaProviderTypes','OpenSchema');
+ while ( my $r = $sth->fetchrow_hashref ) {
+ push
+@{$dbh->{ado_type_info_hash}{$r->{DATA_TYPE}}{$r->{IS_FIXEDLENGTH}}{$r->{IS_LONG}}},
+$r;
+ }
+ }
+ $dbh->{ado_type_info_hash}{$AdoType}{$IsFixed}{$IsLong} || [];
+ }
+
# Attempt to convert an ADO data type into an ODBC/SQL data type.
sub convert_ado_to_odbc {
! my ($dbh, $AdoType, $IsFixed, $IsLong ) = @_;
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 {
