KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

141
database/perl/vendor/lib/DBD/ADO/Const.pm vendored Normal file
View File

@@ -0,0 +1,141 @@
package DBD::ADO::Const;
use strict;
use warnings;
use Win32::OLE();
use Win32::OLE::TypeInfo();
use Win32::OLE::Variant();
$DBD::ADO::Const::VERSION = '0.07';
$DBD::ADO::Const::VT_I4_BYREF = Win32::OLE::Variant::VT_I4()
| Win32::OLE::Variant::VT_BYREF()
;
my $ProgId = 'ADODB.Connection';
my $VarSkip = Win32::OLE::TypeInfo::VARFLAG_FHIDDEN()
| Win32::OLE::TypeInfo::VARFLAG_FRESTRICTED()
| Win32::OLE::TypeInfo::VARFLAG_FNONBROWSABLE()
;
my $Enums;
# -----------------------------------------------------------------------------
sub Enums
# -----------------------------------------------------------------------------
{
my $class = shift;
return $Enums if $Enums;
my $TypeLib = Win32::OLE->new( $ProgId )->GetTypeInfo->GetContainingTypeLib;
return $Enums = $TypeLib->Enums if defined &Win32::OLE::TypeLib::Enums;
for my $i ( 0 .. $TypeLib->_GetTypeInfoCount - 1 )
{
my $TypeInfo = $TypeLib->_GetTypeInfo( $i );
my $TypeAttr = $TypeInfo->_GetTypeAttr;
next unless $TypeAttr->{typekind} == Win32::OLE::TypeInfo::TKIND_ENUM();
my $Enum = $Enums->{$TypeInfo->_GetDocumentation->{Name}} = {};
for my $i ( 0 .. $TypeAttr->{cVars} - 1 )
{
my $VarDesc = $TypeInfo->_GetVarDesc( $i );
next if $VarDesc->{wVarFlags} & $VarSkip;
my $Documentation = $TypeInfo->_GetDocumentation( $VarDesc->{memid} );
$Enum->{$Documentation->{Name}} = $VarDesc->{varValue};
}
}
return $Enums;
}
# -----------------------------------------------------------------------------
1;
=head1 NAME
DBD::ADO::Const - ADO Constants
=head1 SYNOPSIS
use DBD::ADO::Const();
$\ = "\n";
my $Enums = DBD::ADO::Const->Enums;
for my $Enum ( sort keys %$Enums )
{
print $Enum;
for my $Const ( sort keys %{$Enums->{$Enum}} )
{
printf " %-35s 0x%X\n", $Const, $Enums->{$Enum}{$Const};
}
}
=head1 DESCRIPTION
In the OLE type library, many constants are defined as members of enums.
It's easy to lookup DBD::ADO constants by name, e.g.:
$ado_consts->{adChar} == 129
Unfortunately, Win32::OLE::Const does not preserve the namespace of the enums.
It's a matter of taste, but I think
$ado_consts->{DataTypeEnum}{adChar} == 129
makes the code more self-documenting.
Furthermore, many DBD::ADO methods return numeric codes. Transforming these
codes into human readable strings requires an inverse lookup by value.
Building the reverse hash for e.g. all datatypes requires that datatype
constants can be distinguished from other constants, i.e. we need the
namespace preserved.
The Enums() method of this package return a hash of hashes for exactly this
purpose.
=head1 BENCHMARK
The drawback of the Enums() method is its poor performance, as the following
benchmark shows:
require DBD::ADO::Const; # 0.50 CPU
DBD::ADO::Const->Enums; # 0.30 CPU
# 0.80 CPU
However, the previous alternative didn't perform better:
require Win32::OLE::Const; # 0.89 CPU
Win32::OLE::Const->Load(...) # 0.03 CPU
# 0.92 CPU
It seems that all available type libraries are checked (for whatever reason).
In a networking environment, the performance may be unacceptable.
A more general version (parameterized by TypeLib), implemented in XS
(similar to Win32::OLE::Const::_Constants), looks promising:
require Win32::OLE; # 0.24 CPU
$TypeLib->Enums; # 0.04 CPU
# 0.28 CPU
where
$TypeLib = Win32::OLE->new('ADODB.Connection')
->GetTypeInfo->GetContainingTypeLib;
Hopefully, this implementation (see ex/Enums.patch) finds its way
into Win32::OLE some day ...
=head1 AUTHOR
Steffen Goeldner (sgoeldner@cpan.org)
=head1 COPYRIGHT
Copyright (c) 2002-2005 Steffen Goeldner. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut

76
database/perl/vendor/lib/DBD/ADO/GetInfo.pm vendored Normal file
View File

@@ -0,0 +1,76 @@
package DBD::ADO::GetInfo;
use strict;
my $fmt = '%02d.%02d.%1d%1d%1d%1d'; # ODBC version string: ##.##.#####
my $sql_driver_ver = sprintf $fmt, split(/[\._]/,"$DBD::ADO::VERSION.0.0.0.0.0");
our %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
, 36 => \&sql_mult_result_sets # SQL_MULT_RESULT_SETS
);
our %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
);
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;
}
sub sql_mult_result_sets
{
$_[0]->{ado_conn}->Properties->{'Multiple Results'}{Value} ? 'Y':'N';
}
1;

505
database/perl/vendor/lib/DBD/ADO/TypeInfo.pm vendored Normal file
View File

@@ -0,0 +1,505 @@
package DBD::ADO::TypeInfo;
use strict;
use warnings;
use DBI();
use DBD::ADO::Const();
$DBD::ADO::TypeInfo::VERSION = '2.83';
my $Enums = DBD::ADO::Const->Enums;
my $Dt = $Enums->{DataTypeEnum};
# -----------------------------------------------------------------------------
$DBD::ADO::TypeInfo::Fields =
# -----------------------------------------------------------------------------
{
TYPE_NAME => 0
, DATA_TYPE => 1
, COLUMN_SIZE => 2
, LITERAL_PREFIX => 3
, LITERAL_SUFFIX => 4
, CREATE_PARAMS => 5
, NULLABLE => 6
, CASE_SENSITIVE => 7
, SEARCHABLE => 8
, UNSIGNED_ATTRIBUTE => 9
, FIXED_PREC_SCALE => 10
, AUTO_UNIQUE_VALUE => 11
, LOCAL_TYPE_NAME => 12
, MINIMUM_SCALE => 13
, MAXIMUM_SCALE => 14
, SQL_DATA_TYPE => 15
, SQL_DATETIME_SUB => 16
# NUM_PREC_RADIX => 17
# INTERVAL_PRECISION => 18
};
# -----------------------------------------------------------------------------
$DBD::ADO::TypeInfo::dbi2ado =
# -----------------------------------------------------------------------------
{
DBI::SQL_GUID() => $Dt->{adGUID} # -11
, DBI::SQL_WLONGVARCHAR() => $Dt->{adLongVarWChar} # -10
, DBI::SQL_WVARCHAR() => $Dt->{adVarWChar} # -9
, DBI::SQL_WCHAR() => $Dt->{adWChar} # -8
# DBI::SQL_BIT() # -7
, DBI::SQL_TINYINT() => $Dt->{adTinyInt} # -6
, -5 => $Dt->{adBigInt} # SQL_BIGINT
, DBI::SQL_LONGVARBINARY() => $Dt->{adLongVarBinary} # -4
, DBI::SQL_VARBINARY() => $Dt->{adVarBinary} # -3
, DBI::SQL_BINARY() => $Dt->{adBinary} # -2
, DBI::SQL_LONGVARCHAR() => $Dt->{adLongVarChar} # -1
# DBI::SQL_UNKNOWN_TYPE() => # 0
, DBI::SQL_CHAR() => $Dt->{adChar} # 1
, DBI::SQL_NUMERIC() => $Dt->{adNumeric} # 2
, DBI::SQL_DECIMAL() => $Dt->{adDecimal} # 3
, DBI::SQL_INTEGER() => $Dt->{adInteger} # 4
, DBI::SQL_SMALLINT() => $Dt->{adSmallInt} # 5
, DBI::SQL_FLOAT() => $Dt->{adSingle} # 6
# DBI::SQL_REAL() => # 7
, DBI::SQL_DOUBLE() => $Dt->{adDouble} # 8
, DBI::SQL_DATE() => $Dt->{adDBDate} # 9 # deprecated!
# DBI::SQL_INTERVAL() => # 10
, DBI::SQL_TIMESTAMP() => $Dt->{adDBTimeStamp} # 11 # deprecated!
, DBI::SQL_VARCHAR() => $Dt->{adVarChar} # 12
, DBI::SQL_BOOLEAN() => $Dt->{adBoolean} # 16
, DBI::SQL_UDT() => $Dt->{adUserDefined} # 17
# DBI::SQL_UDT_LOCATOR() => # 18
# DBI::SQL_ROW() => # 19
# DBI::SQL_REF() => # 20
, 25 => $Dt->{adBigInt} # SQL_BIGINT
, DBI::SQL_BLOB() => $Dt->{adLongVarBinary} # 30
# DBI::SQL_BLOB_LOCATOR() => # 31
, DBI::SQL_CLOB() => $Dt->{adLongVarChar} # 40
# DBI::SQL_CLOB_LOCATOR() => # 41
, DBI::SQL_ARRAY() => $Dt->{adArray} # 50
# DBI::SQL_ARRAY_LOCATOR() => # 51
# DBI::SQL_MULTISET() => # 55
# DBI::SQL_MULTISET_LOCATOR()=> # 56
, DBI::SQL_TYPE_DATE() => $Dt->{adDBDate} # 91
, DBI::SQL_TYPE_TIME() => $Dt->{adDBTime} # 92
, DBI::SQL_TYPE_TIMESTAMP() => $Dt->{adDBTimeStamp} # 93
# DBI::SQL_TYPE_TIME_WITH_TIMEZONE() # 94
# DBI::SQL_TYPE_TIMESTAMP_WITH_TIMEZONE() # 95
# DBI::SQL_INTERVAL_YEAR() # 101
# DBI::SQL_INTERVAL_MONTH() # 102
# DBI::SQL_INTERVAL_DAY() # 103
# DBI::SQL_INTERVAL_HOUR() # 104
# DBI::SQL_INTERVAL_MINUTE() # 105
# DBI::SQL_INTERVAL_SECOND() # 106
# DBI::SQL_INTERVAL_YEAR_TO_MONTH() # 107
# DBI::SQL_INTERVAL_DAY_TO_HOUR() # 108
# DBI::SQL_INTERVAL_DAY_TO_MINUTE() # 109
# DBI::SQL_INTERVAL_DAY_TO_SECOND() # 110
# DBI::SQL_INTERVAL_HOUR_TO_MINUTE() # 111
# DBI::SQL_INTERVAL_HOUR_TO_SECOND() # 112
# DBI::SQL_INTERVAL_MINUTE_TO_SECOND() # 113
};
# -----------------------------------------------------------------------------
my $ado2dbi =
# -----------------------------------------------------------------------------
{
$Dt->{adArray} => DBI::SQL_ARRAY
, $Dt->{adBigInt} => 25
, $Dt->{adBinary} => DBI::SQL_BINARY
, $Dt->{adBoolean} => DBI::SQL_BOOLEAN
, $Dt->{adBSTR} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adChapter} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adChar} => DBI::SQL_CHAR
, $Dt->{adCurrency} => DBI::SQL_NUMERIC
, $Dt->{adDate} => DBI::SQL_TYPE_TIMESTAMP # XXX Not really!
, $Dt->{adDBDate} => DBI::SQL_TYPE_DATE
, $Dt->{adDBTime} => DBI::SQL_TYPE_TIME
, $Dt->{adDBTimeStamp} => DBI::SQL_TYPE_TIMESTAMP
, $Dt->{adDecimal} => DBI::SQL_DECIMAL
, $Dt->{adDouble} => DBI::SQL_DOUBLE
, $Dt->{adEmpty} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adError} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adFileTime} => DBI::SQL_TIMESTAMP
, $Dt->{adGUID} => DBI::SQL_GUID
, $Dt->{adIDispatch} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adInteger} => DBI::SQL_INTEGER
, $Dt->{adIUnknown} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adLongVarBinary} => DBI::SQL_LONGVARBINARY
, $Dt->{adLongVarChar} => DBI::SQL_LONGVARCHAR
, $Dt->{adLongVarWChar} => DBI::SQL_WLONGVARCHAR
, $Dt->{adNumeric} => DBI::SQL_NUMERIC
, $Dt->{adPropVariant} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adSingle} => DBI::SQL_FLOAT
, $Dt->{adSmallInt} => DBI::SQL_SMALLINT
, $Dt->{adTinyInt} => DBI::SQL_TINYINT
, $Dt->{adUnsignedBigInt} => 25
, $Dt->{adUnsignedInt} => DBI::SQL_INTEGER
, $Dt->{adUnsignedSmallInt} => DBI::SQL_SMALLINT
, $Dt->{adUnsignedTinyInt} => DBI::SQL_TINYINT
, $Dt->{adUserDefined} => DBI::SQL_UDT
, $Dt->{adVarBinary} => DBI::SQL_VARBINARY
, $Dt->{adVarChar} => DBI::SQL_VARCHAR
, $Dt->{adVariant} => DBI::SQL_UNKNOWN_TYPE
, $Dt->{adVarNumeric} => DBI::SQL_NUMERIC
, $Dt->{adVarWChar} => DBI::SQL_WVARCHAR
, $Dt->{adWChar} => DBI::SQL_WCHAR
};
# -----------------------------------------------------------------------------
my $ado2dbi3 =
# -----------------------------------------------------------------------------
{
# AdoType IsLong IsFixed => SqlType
$Dt->{adBinary } => { 0 => { 0 => DBI::SQL_VARBINARY
, 1 => DBI::SQL_BINARY }
, 1 => { 0 => DBI::SQL_LONGVARBINARY
, 1 => DBI::SQL_UNKNOWN_TYPE }}
, $Dt->{adChar } => { 0 => { 0 => DBI::SQL_VARCHAR
, 1 => DBI::SQL_CHAR }
, 1 => { 0 => DBI::SQL_LONGVARCHAR
, 1 => DBI::SQL_UNKNOWN_TYPE }}
, $Dt->{adWChar } => { 0 => { 0 => DBI::SQL_WVARCHAR
, 1 => DBI::SQL_WCHAR }
, 1 => { 0 => DBI::SQL_WLONGVARCHAR
, 1 => DBI::SQL_UNKNOWN_TYPE }}
# $Dt->{adVarBinary} =>
# $Dt->{adVarChar } =>
# $Dt->{adVarWChar } =>
};
# -----------------------------------------------------------------------------
sub ado2dbi # Convert an ADO data type into an DBI/ODBC/SQL data type.
# -----------------------------------------------------------------------------
{
my ( $AdoType, $IsFixed, $IsLong ) = @_;
$IsFixed = 0 unless $IsFixed;
$IsLong = 0 unless $IsLong ;
# return $dbh->set_err( -1,"ado2dbi: call without any attributes")
# unless $AdoType;
my $SqlType = 0;
if ( $AdoType & $Dt->{adArray} ) { # XXX: & vs. ==
$SqlType = 50; # XXX DBI::SQL_ARRAY();
}
elsif ( exists $ado2dbi3->{$AdoType}{$IsLong}{$IsFixed} ) {
$SqlType = $ado2dbi3->{$AdoType}{$IsLong}{$IsFixed};
}
elsif ( exists $ado2dbi->{$AdoType} ) {
$SqlType = $ado2dbi->{$AdoType};
}
# print "==> $AdoType, $IsFixed, $IsLong => $SqlType\n";
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 determine_type_support
# -----------------------------------------------------------------------------
{
my ( $dbh ) = @_;
die 'dbh undefined' unless $dbh;
$dbh->trace_msg(" -> ado_determine_type_support\n", 3 );
# Attempt to convert data types from ODBC to ADO.
my %local_types = (
DBI::SQL_BINARY() => [
$Dt->{adBinary}
, $Dt->{adVarBinary}
]
, DBI::SQL_BIT() => [ $Dt->{adBoolean}]
, DBI::SQL_CHAR() => [
$Dt->{adChar}
, $Dt->{adVarChar}
, $Dt->{adWChar}
, $Dt->{adVarWChar}
]
, DBI::SQL_DATE() => [
$Dt->{adDBTimeStamp}
, $Dt->{adDate}
]
, DBI::SQL_DECIMAL() => [ $Dt->{adNumeric} ]
, DBI::SQL_DOUBLE() => [ $Dt->{adDouble} ]
, DBI::SQL_FLOAT() => [ $Dt->{adSingle} ]
, DBI::SQL_INTEGER() => [ $Dt->{adInteger} ]
, DBI::SQL_LONGVARBINARY() => [
$Dt->{adLongVarBinary}
, $Dt->{adVarBinary}
, $Dt->{adBinary}
]
, DBI::SQL_LONGVARCHAR() => [
$Dt->{adLongVarChar}
, $Dt->{adVarChar}
, $Dt->{adChar}
, $Dt->{adLongVarWChar}
, $Dt->{adVarWChar}
, $Dt->{adWChar}
]
, DBI::SQL_NUMERIC() => [ $Dt->{adNumeric} ]
, DBI::SQL_REAL() => [ $Dt->{adSingle} ]
, DBI::SQL_SMALLINT() => [ $Dt->{adSmallInt} ]
, DBI::SQL_TIMESTAMP() => [
$Dt->{adDBTime}
, $Dt->{adDBTimeStamp}
, $Dt->{adDate}
]
, DBI::SQL_TINYINT() => [ $Dt->{adUnsignedTinyInt} ]
, DBI::SQL_VARBINARY() => [
$Dt->{adVarBinary}
, $Dt->{adLongVarBinary}
, $Dt->{adBinary}
]
, DBI::SQL_VARCHAR() => [
$Dt->{adVarChar}
, $Dt->{adChar}
, $Dt->{adVarWChar}
, $Dt->{adWChar}
]
, DBI::SQL_WCHAR() => [
$Dt->{adWChar}
, $Dt->{adVarWChar}
, $Dt->{adLongVarWChar}
]
, DBI::SQL_WVARCHAR() => [
$Dt->{adVarWChar}
, $Dt->{adLongVarWChar}
, $Dt->{adWChar}
]
, DBI::SQL_WLONGVARCHAR() => [
$Dt->{adLongVarWChar}
, $Dt->{adVarWChar}
, $Dt->{adWChar}
, $Dt->{adLongVarChar}
, $Dt->{adVarChar}
, $Dt->{adChar}
]
);
my @sql_types = (
DBI::SQL_BINARY()
, DBI::SQL_BIT()
, DBI::SQL_CHAR()
, DBI::SQL_DATE()
, DBI::SQL_DECIMAL()
, DBI::SQL_DOUBLE()
, DBI::SQL_FLOAT()
, DBI::SQL_INTEGER()
, DBI::SQL_LONGVARBINARY()
, DBI::SQL_LONGVARCHAR()
, DBI::SQL_NUMERIC()
, DBI::SQL_REAL()
, DBI::SQL_SMALLINT()
, DBI::SQL_TIMESTAMP()
, DBI::SQL_TINYINT()
, DBI::SQL_VARBINARY()
, DBI::SQL_VARCHAR()
, DBI::SQL_WCHAR()
, DBI::SQL_WVARCHAR()
, DBI::SQL_WLONGVARCHAR()
);
# Get the Provider Types attributes.
my $QueryType = 'adSchemaProviderTypes';
my $conn = $dbh->{ado_conn};
my @sort_rows;
my %ct;
my $rs = $conn->OpenSchema( $Enums->{SchemaEnum}{$QueryType} );
return if DBD::ADO::Failed( $dbh,"Can't OpenSchema ($QueryType)");
my @ado_info = map { $_->Name } Win32::OLE::in( $rs->Fields );
while ( !$rs->{EOF} ) {
# Sort by row
my $type_name = $rs->{TYPE_NAME}{Value};
my $def;
push ( @sort_rows, $def = join(' '
, $rs->{DATA_TYPE }{Value}
, $rs->{BEST_MATCH }{Value} || 0
, $rs->{IS_LONG }{Value} || 0
, $rs->{IS_FIXEDLENGTH}{Value} || 0
, $rs->{COLUMN_SIZE }{Value}
, $rs->{TYPE_NAME }{Value}
));
$dbh->trace_msg(" -- data type $type_name: $def\n", 5 );
@{$ct{$type_name}} = map { $rs->{$_}{Value} || '' } @ado_info;
$rs->MoveNext;
}
$rs->Close if $rs && $rs->State & $Enums->{ObjectStateEnum}{adStateOpen};
$rs = undef;
for my $t ( @sql_types ) {
# Attempt to work with LONG text fields.
# However for a LONG field, the order by ... isn't always the best pick.
# Loop through the rows looking for something with a IS LONG mark.
my $alt = join '|', @{$local_types{$t}};
my $re;
if ( $t == DBI::SQL_LONGVARCHAR() ) { $re = qr{^($alt)\s\d\s1\s0\s} }
elsif ( $t == DBI::SQL_LONGVARBINARY() ) { $re = qr{^($alt)\s\d\s1\s0\s} }
elsif ( $t == DBI::SQL_VARBINARY() ) { $re = qr{^($alt)\s1\s\d\s0\s} }
elsif ( $t == DBI::SQL_VARCHAR() ) { $re = qr{^($alt)\s[01]\s0\s0\s}}
elsif ( $t == DBI::SQL_WVARCHAR() ) { $re = qr{^($alt)\s[01]\s0\s0\s}}
elsif ( $t == DBI::SQL_WLONGVARCHAR() ) { $re = qr{^($alt)\s\d\s1\s0\s} }
elsif ( $t == DBI::SQL_CHAR() ) { $re = qr{^($alt)\s\d\s0\s1\s} }
elsif ( $t == DBI::SQL_WCHAR() ) { $re = qr{^($alt)\s\d\s0\s1\s} }
else { $re = qr{^($alt)\s\d\s\d\s} }
for ( sort { $b cmp $a } grep { /$re/ } @sort_rows ) {
my ( $cc ) = m/\d+\s+(\D\w?.*)$/;
Carp::carp "$cc does not exist in hash\n" unless exists $ct{$cc};
my @rec = @{$ct{$cc}};
$dbh->trace_msg(" ** Changing type $rec[1] -> $t : @rec\n", 6 );
$rec[1] = $t;
push @{$dbh->{ado_all_types_supported}}, \@rec;
}
}
$dbh->trace_msg(" <- ado_determine_type_support\n", 3 );
return \@{$dbh->{ado_all_types_supported}};
}
# -----------------------------------------------------------------------------
sub type_info_all_1
# -----------------------------------------------------------------------------
{
my ( $dbh ) = @_;
my $QueryType = 'adSchemaProviderTypes';
my $names = {
TYPE_NAME => 0
, DATA_TYPE => 1
, COLUMN_SIZE => 2
, LITERAL_PREFIX => 3
, LITERAL_SUFFIX => 4
, CREATE_PARAMS => 5
, NULLABLE => 6
, CASE_SENSITIVE => 7
, SEARCHABLE => 8
, UNSIGNED_ATTRIBUTE => 9
, FIXED_PREC_SCALE => 10
, AUTO_UNIQUE_VALUE => 11
, LOCAL_TYPE_NAME => 12
, MINIMUM_SCALE => 13
, MAXIMUM_SCALE => 14
};
# If the type information is previously obtained, use it.
unless ( $dbh->{ado_all_types_supported} ) {
DBD::ADO::TypeInfo::determine_type_support( $dbh )
or Carp::croak "Can't determine_type_support: $dbh->{errstr}";
}
my $ops = DBD::ADO::db::ado_open_schema( $dbh, $QueryType )
or Carp::croak "Can't OpenSchema ($QueryType)";
my $sth = DBI->connect('dbi:Sponge:','','', { RaiseError => 1 } )->prepare(
$QueryType, { rows => [ @{$dbh->{ado_all_types_supported}} ]
, NAME => [ @{$ops->{NAME}} ]
});
$ops->finish; $ops = undef;
my @ti;
while ( my $row = $sth->fetchrow_hashref ) {
my $ti;
# Only add items from the above names list.
# When this list explans, the code 'should' still work.
while ( my ( $k, $v ) = each %$names ) {
$ti->[$v] = $row->{$k} || '';
}
push @ti, $ti;
}
return [ $names, @ti ];
}
# -----------------------------------------------------------------------------
sub type_info_all_2
# -----------------------------------------------------------------------------
{
my ( $dbh ) = @_;
my $QueryType = 'adSchemaProviderTypes';
my $conn = $dbh->{ado_conn};
my @Rows;
my $rs = $conn->OpenSchema( $Enums->{SchemaEnum}{$QueryType} );
return if DBD::ADO::Failed( $dbh,"Can't OpenSchema ($QueryType)");
while ( !$rs->{EOF} ) {
my $AdoType = $rs->{DATA_TYPE }{Value};
my $IsLong = $rs->{IS_LONG }{Value};
my $IsFixed = $rs->{IS_FIXEDLENGTH}{Value};
my @SqlType = DBD::ADO::TypeInfo::ado2dbi( $AdoType, $IsFixed, $IsLong );
my $Fields =
[
$rs->{TYPE_NAME }{Value} # 0 TYPE_NAME
, $SqlType[0] # 1 DATA_TYPE
, $rs->{COLUMN_SIZE }{Value} # 2 COLUMN_SIZE
, $rs->{LITERAL_PREFIX }{Value} # 3 LITERAL_PREFIX
, $rs->{LITERAL_SUFFIX }{Value} # 4 LITERAL_SUFFIX
, $rs->{CREATE_PARAMS }{Value} # 5 CREATE_PARAMS
, $rs->{IS_NULLABLE }{Value} # 6 NULLABLE
, $rs->{CASE_SENSITIVE }{Value} # 7 CASE_SENSITIVE
, $rs->{SEARCHABLE }{Value} # 8 SEARCHABLE
, $rs->{UNSIGNED_ATTRIBUTE}{Value} # 9 UNSIGNED_ATTRIBUTE
, $rs->{FIXED_PREC_SCALE }{Value} # 10 FIXED_PREC_SCALE
, $rs->{AUTO_UNIQUE_VALUE }{Value} # 11 AUTO_UNIQUE_VALUE
, $rs->{LOCAL_TYPE_NAME }{Value} # 12 LOCAL_TYPE_NAME
, $rs->{MINIMUM_SCALE }{Value} # 13 MINIMUM_SCALE
, $rs->{MAXIMUM_SCALE }{Value} # 14 MAXIMUM_SCALE
, $SqlType[1] # 15 SQL_DATA_TYPE
, $SqlType[2] # 16 SQL_DATETIME_SUB
];
$Fields->[8]--;
push @Rows, $Fields;
$rs->MoveNext;
}
$rs->Close; undef $rs;
# TODO: 2nd crit. for equal types
return [ $DBD::ADO::TypeInfo::Fields, sort { $a->[1] <=> $b->[1] } @Rows ];
}
# -----------------------------------------------------------------------------
sub Find3
# -----------------------------------------------------------------------------
{
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} || [];
}
# -----------------------------------------------------------------------------
1;
=head1 NAME
DBD::ADO::TypeInfo - ADO TypeInfo
=head1 SYNOPSIS
use DBD::ADO::TypeInfo();
...
=head1 DESCRIPTION
This module helps to handle DBI datatype information.
It provides mappings between DBI (SQL/CLI, ODBC) and ADO datatypes.
=head1 AUTHOR
Steffen Goeldner (sgoeldner@cpan.org)
=head1 COPYRIGHT
Copyright (c) 2002-2005 Steffen Goeldner. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut