DBD-ADO
view release on metacpan or search on metacpan
lib/DBD/ADO.pm view on Meta::CPAN
$dbh->{AutoCommit} = 1;
$dbh->SUPER::STORE('BegunWork', 0 );
$conn->{Attributes} = 0;
return if DBD::ADO::Failed( $dbh,"Can't set CommitRetaining");
}
if ( defined $conn && $conn->State & $Enums->{ObjectStateEnum}{adStateOpen} ) {
$conn->RollbackTrans;
return if DBD::ADO::Failed( $dbh,"Can't Rollback transaction");
}
return 1;
}
# The create parm methods builds a usable type statement for constructing
# tables.
# XXX This method may not stay ...
sub create_parm {
my ( $dbh, $type ) = @_;
my $field = undef;
if ( $type ) {
$field = $type->{TYPE_NAME};
if ( defined $type->{CREATE_PARAMS} ) {
$field .= '(' . $type->{COLUMN_SIZE} . ')'
if $type->{CREATE_PARAMS} =~ /LENGTH/i;
$field .= '(' . $type->{COLUMN_SIZE} . ', 0)'
if $type->{CREATE_PARAMS} =~ /PRECISION,SCALE/i;
}
}
return $field;
}
sub prepare {
my ( $dbh, $statement, $attr ) = @_;
my $conn = $dbh->{ado_conn};
my $comm = Win32::OLE->new('ADODB.Command');
return if DBD::ADO::Failed( $dbh,"Can't create 'ADODB.Command'");
$comm->{ActiveConnection} = $conn;
return if DBD::ADO::Failed( $dbh,"Can't set ActiveConnection");
$comm->{CommandText} = $statement;
return if DBD::ADO::Failed( $dbh,"Can't set CommandText");
my $ct = $attr->{CommandType} ? $attr->{CommandType} : 'adCmdText';
$comm->{CommandType} = $Enums->{CommandTypeEnum}{$ct};
return if DBD::ADO::Failed( $dbh,"Can't set CommandType");
$comm->{CommandTimeout} = defined $attr->{ado_commandtimeout}
? $attr->{ado_commandtimeout} : $conn->{CommandTimeout};
return if DBD::ADO::Failed( $dbh,"Can't set CommandTimeout");
my ( $outer, $sth ) = DBI::_new_sth( $dbh, { Statement => $statement } );
$sth->{ado_cachesize} = $dbh->{ado_cachesize};
$sth->{ado_comm} = $comm;
$sth->{ado_conn} = $conn;
$sth->{ado_cursortype} = $dbh->{ado_cursortype} || $attr->{CursorType};
$sth->{ado_fields} = undef;
$sth->{ado_max_errors} = $dbh->{ado_max_errors};
$sth->{ado_refresh} = 1;
$sth->{ado_rownum} = -1;
$sth->{ado_rows} = -1;
$sth->{ado_rowset} = undef;
$sth->{ado_type} = undef;
$sth->{ado_usecmd} = undef;
$sth->{ado_users} = undef;
$sth->{ado_executeoption} = 0;
# Set overrides for and attributes.
for my $key ( grep { /^ado_/ } keys %$attr ) {
next if $key eq 'ado_commandtimeout';
$sth->trace_msg(" -- Attribute: $key => $attr->{$key}\n", 5 );
if ( exists $sth->{$key} ) {
$sth->{$key} = $attr->{$key};
}
else {
warn "Unknown attribute $key\n";
}
}
my $Cnt;
if ( $sth->{ado_refresh} == 1 ) {
# Refresh() is - among other things - useful to detect syntax errors.
# The eval block is used because Refresh() may not be supported (but
# no such case is known).
# Buggy drivers, e.g. FoxPro, may leave the Parameters collection
# empty, without returning an error. Then _refresh() is deferred until
# bind_param() is called.
eval {
local $Win32::OLE::Warn = 0;
$comm->Parameters->Refresh;
$Cnt = $comm->Parameters->Count;
};
my $lastError = DBD::ADO::errors( $dbh );
if ( $lastError ) {
$dbh->trace_msg(" !! Refresh error: $lastError\n", 5 );
$sth->{ado_refresh} = 2;
}
}
if ( $sth->{ado_refresh} == 2 ) {
$Cnt = DBD::ADO::st::_refresh( $sth );
}
# LRB
if ( $sth->{ado_executeoption} && $sth->{ado_executeoption} == $Enums->{ExecuteOptionEnum}{adExecuteStream}) {
my $sResponseStream = Win32::OLE->new('ADODB.Stream');
return if DBD::ADO::Failed($dbh, "Can't create 'ADODB.Stream'");
$sResponseStream->Open();
return if DBD::ADO::Failed($dbh, "Can't open 'ADODB.Stream'");
my $vObj = Win32::OLE::Variant->new(Win32::OLE::Variant::VT_VARIANT()|Win32::OLE::Variant::VT_BYREF(), $sResponseStream);
return if DBD::ADO::Failed($dbh, "Can't create Variant for 'ADODB.Stream'");
$comm->{Properties}{'Output Stream'}{Value} = $vObj;
$sth->{ado_responsestream} = $sResponseStream;
}
if ( $Cnt ) {
# Describe the Parameters:
for my $p ( Win32::OLE::in( $comm->Parameters ) ) {
my @p = map "$_ => $p->{$_}", qw(Name Type Direction Size);
lib/DBD/ADO.pm view on Meta::CPAN
|| $i->{Type} == $Enums->{DataTypeEnum}{adLongVarBinary}
) {
my $pic = Win32::OLE::Variant->new( Win32::OLE::Variant::VT_UI1() | Win32::OLE::Variant::VT_ARRAY(), $i->{Size} );
return $sth->set_err( -935, "Failed to create a Variant array of size $i->{Size}.")
unless defined $pic;
$pic->Put( $value );
$i->{Value} = $pic;
$sth->trace_msg(" -- Binary: $i->{Type} $i->{Size}\n", 5 );
}
else {
$i->{Value} = $value;
$sth->trace_msg(" -- Type : $i->{Type} $i->{Size}\n", 5 );
}
}
else {
$i->{Value} = Win32::OLE::Variant->new( Win32::OLE::Variant::VT_NULL() );
}
}
sub _retrieve_out_params {
my ( $sth ) = @_;
my $comm = $sth->{ado_comm};
my $is_stored_procedure = $comm->{CommandType} == $Enums->{CommandTypeEnum}{adCmdStoredProc};
while ( my ( $n, $vref ) = each %{$sth->{ado_ParamRefs}} ) {
my $value = $comm->Parameters->Item( $n - ( $is_stored_procedure ? 0 : 1 ) )->{Value};
# XXX perhaps should translate Variant null representation, here, first?
$sth->{ParamValues}{$n} = $$vref = $value;
$sth->trace_msg(" -- _retrieve_out_params : param => $n value => '$value'\n", 5 );
}
if ($is_stored_procedure) {
$sth->{ado_returnvalue} = $comm->Parameters->Item( 0 )->{Value};
$sth->trace_msg(" -- _retrieve_out_params : param => RETURN_VALUE value => '$sth->{ado_returnvalue}'\n", 5 );
}
}
sub execute {
my ( $sth, @bind_values ) = @_;
my $conn = $sth->{ado_conn};
my $comm = $sth->{ado_comm};
my $sql = $sth->FETCH('Statement');
my $rows = Win32::OLE::Variant->new( $DBD::ADO::Const::VT_I4_BYREF, 0 );
my $rs;
$sth->finish if $sth->{Active};
$sth->bind_param( $_, $bind_values[$_-1] ) or return for 1 .. @bind_values;
## delayed binding of by-ref input[/output] parameters
unless (@bind_values) {
while ( my ( $n, $vref ) = each %{$sth->{ado_ParamRefs}} ) {
my $i = $comm->Parameters->Item( $n - ($comm->{CommandType} == $Enums->{CommandTypeEnum}{adCmdStoredProc} ? 0 : 1) );
if ( $i->{Direction} & $Enums->{ParameterDirectionEnum}{adParamInput} ) {
# probably don't need the ternary; creation of ado_maxlen should
# guarantee that this will always exist
my $attr = defined $sth->{ado_ParamRefAttrs}{$n} ? $sth->{ado_ParamRefAttrs}{$n} : undef;
_assign_param( $sth, $n, $$vref, $attr, $i );
}
}
}
# At this point a Command is ready to Execute. To allow for different
# type of cursors, we need to create a Recordset object.
# However, a Recordset Open does not return affected rows. So we need to
# determine if a Recordset Open is needed, or a Command Execute.
my $UseRecordSet = !defined $sth->{ado_usecmd} &&
( defined $sth->{ado_cursortype}
|| defined $sth->{ado_users}
);
my $UseResponseStream = $sth->{ado_executeoption} &&
( $sth->{ado_executeoption} == $Enums->{ExecuteOptionEnum}{adExecuteStream} );
if ( $UseResponseStream ) {
$sth->trace_msg(" -- Execute: Using Response Stream\n", 5 );
$comm->Execute( { 'Options' => $sth->{ado_executeoption} } );
return if DBD::ADO::Failed( $sth,"Can't Execute Command '$sql'");
_retrieve_out_params( $sth );
return $sth->{ado_responsestream}->ReadText();
}
elsif ( $UseRecordSet ) {
$rs = Win32::OLE->new('ADODB.RecordSet');
return if DBD::ADO::Failed( $sth,"Can't create 'ADODB.RecordSet'");
my $CursorType = $sth->{ado_cursortype} || 'adOpenForwardOnly';
$sth->trace_msg(" -- Open Recordset using CursorType '$CursorType'\n", 5 );
$rs->Open( $comm, undef, $Enums->{CursorTypeEnum}{$CursorType} );
return if DBD::ADO::Failed( $sth,"Can't Open Recordset for '$sql'");
_retrieve_out_params( $sth );
$sth->trace_msg(" -- CursorType: $rs->{CursorType}\n", 5 );
}
else {
$rs = $comm->Execute( $rows );
return if DBD::ADO::Failed( $sth,"Can't Execute Command '$sql'");
_retrieve_out_params( $sth );
}
$rows = $rows->Value; # to make a DBD::Proxy client w/o Win32::OLE happy
my @Fields;
# some providers close the rs, e.g. after DROP TABLE
if ( defined $rs && $rs->State ) {
@Fields = Win32::OLE::in( $rs->Fields );
return if DBD::ADO::Failed( $sth,"Can't enumerate Fields");
}
$sth->{ado_fields} = \@Fields;
my $num_of_fields = @Fields;
if ( $num_of_fields == 0 ) { # assume non-select statement
$sth->trace_msg(" -- no fields (non-select statement?)\n", 5 );
# Clean up the record set that isn't used.
if ( defined $rs && (ref $rs) =~ /Win32::OLE/) {
$rs->Close if $rs && $rs->State & $Enums->{ObjectStateEnum}{adStateOpen};
}
$rs = undef;
$sth->{ado_rows} = $rows;
return $rows || '0E0';
}
if ( defined $sth->{ado_cachesize} && $sth->{ado_cachesize} > 0 ) {
$sth->trace_msg(" -- changing CacheSize $rs->{CacheSize} => $sth->{ado_cachesize}\n", 5 );
$rs->{CacheSize} = $sth->{ado_cachesize};
my $lastError = DBD::ADO::errors( $sth );
$sth->set_err( 0, $lastError ) if $lastError;
}
my $Attributes;
$Attributes |= $_->Attributes for @Fields;
$sth->{ado_has_lob} = $Attributes & $Enums->{FieldAttributeEnum}{adFldLong} ? 1 : 0;
$sth->{ado_rowset} = $rs;
$sth->{ado_rownum} = 0;
$sth->{ado_rows} = $rows; # $rs->RecordCount
$sth->{ado_type} = [ map { $_->Type } @Fields ];
$sth->{NAME} = [ map { $_->Name } @Fields ];
$sth->{TYPE} = [ map { scalar DBD::ADO::TypeInfo::ado2dbi( $_->Type ) } @Fields ];
$sth->{PRECISION} = [ map { $_->Precision } @Fields ];
$sth->{SCALE} = [ map { $_->NumericScale } @Fields ];
$sth->{NULLABLE} = [ map { $_->Attributes & $Enums->{FieldAttributeEnum}{adFldMayBeNull} ? 1 : 0 } @Fields ];
$sth->STORE('Statement' , $rs->Source );
$sth->STORE('NUM_OF_FIELDS', $num_of_fields );
$sth->STORE('Active' , 1 );
# We need to return a true value for a successful select
# -1 means total row count unavailable
return $rows || '0E0'; # seems more reliable than $rs->RecordCount
lib/DBD/ADO.pm view on Meta::CPAN
'File Name' argument. If you omit these arguments, Provider defaults
to MSDASQL (Microsoft OLE DB Provider for ODBC). Therefore you can
pass an ODBC connection string (with DSN or DSN-less) as valid ADO
connection string.
If you use the OLE DB Provider for ODBC, it may be better to omit this
additional layer and use DBD::ODBC with the ODBC driver.
In addition the following attributes may be set in the connection string:
Attributes
CommandTimeout
ConnectionString
ConnectionTimeout
CursorLocation
DefaultDatabase
IsolationLevel
Mode
B<Warning:> This feature is supported for backward compatibility.
It's saver to use the driver specific attributes described above.
Anyway, the application is responsible for passing the correct
values when setting any of these attributes.
See the ADO documentation for more information on connection strings.
ADO ConnectionString examples:
test
File Name=test.udl
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\data\test.mdb
Provider=VFPOLEDB;Data Source=C:\data\test.dbc
Provider=MSDAORA
For more examples, see e.g.:
http://www.able-consulting.com/tech.htm
=head2 data_sources
Because ADO doesn't provide a data source repository, DBD::ADO uses it's
own. It tries to load Local::DBD::ADO::DSN and expects an array of hashes
describing the data sources. See ex/Local/DBD/ADO/DSN.pm for an example.
B<Warning:> This is experimental and may change.
B<Warning:> Check for the unlikly case that a file Local/DBD/ADO/DSN.pm
exists in your module search path which causes unwanted side effects when
loaded.
=head2 prepare
The B<prepare> methods allows attributes (see DBI):
$sth = $dbh->prepare( $statement ) or die $dbh->errstr;
$sth = $dbh->prepare( $statement, \%attr ) or die $dbh->errstr;
DBD::ADO's prepare() supports setting the CursorType, e.g.:
$sth = $dbh->prepare( $sql, { ado_cursortype => 'adOpenForwardOnly' } ) ...
# the CursorType attribute is deprecated:
$sth = $dbh->prepare( $sql, { CursorType => 'adOpenForwardOnly' } ) ...
Possible cursortypes are:
adOpenForwardOnly (default)
adOpenKeyset
adOpenDynamic
adOpenStatic
It may be necessary to prepare the statement using cursortype 'adOpenStatic'
when using a statement handle within a statement handle:
while( my $table = $sth1->fetchrow_hashref ) {
...
my $col = $sth2->fetchrow_hashref;
...
}
Changing the CursorType is a solution to the following problem:
Can't execute statement 'select * from authors':
Lasterror : -2147467259
OLE exception from "Microsoft OLE DB Provider for SQL Server":
Cannot create new connection because in manual or distributed transaction
mode.
Win32::OLE(0.1403) error 0x80004005: "Unspecified error"
in METHOD/PROPERTYGET "Open"
Description : Cannot create new connection because in manual or distributed transaction mode.
HelpContext : 0
HelpFile :
NativeError : 0
Number : -2147467259
Source : Microsoft OLE DB Provider for SQL Server
SQLState :
=head2 bind_param
Normally, the datatypes of placeholders are known after the statement is
prepared. In this case, you don't need to provide any type information:
$sth->bind_param( 1, $value );
Sometimes, you need to specify a type for the parameter, e.g.:
$sth->bind_param( 1, $value, SQL_NUMERIC );
As a last resort, you can provide an ADO-specific type, e.g.:
$sth->bind_param( 1, $value, { ado_type => 6 } ); # adCurrency
If no type is given (neither by the provider nor by you), the datatype
defaults to SQL_VARCHAR (adVarChar).
=head2 bind_param_inout
This can be utilized (with IN parameters) to support simple
call-by-reference, allowing for lazy parameter binding.
$sth->bind_param_inout( 1, \$value, 1024 );
The contents of $value will not be dereferenced until the call to
C<$sth-E<gt>execute();> is made. To use IN/OUT parameter types with stored
procedures, remember that you will need to specify the appropriate command
type when preparing the statement, e.g.:
lib/DBD/ADO.pm view on Meta::CPAN
Since version 2.92, DBD::ADO supports the DBI handle attributes C<LongReadLen>
and C<LongTruncOk>.
C<LongReadLen> defaults to C<2147483647> (for backwards compatibility).
For multibyte strings, it's unspecified whether C<LongReadLen> means I<bytes>
or I<characters>. It's passed through to ADO's C<GetChunk> method and
C<ActualSize> property.
B<Caveat:> Unexpected truncation errors may occur if the ADO provider (e.g.
Microsoft.Jet.OLEDB.4.0) uses I<bytes> for C<ActualSize> but I<characters>
for C<GetChunk>.
B<Caveat:> The ADO provider may have problems if the long field isn't the last
one in the list of selected columns, e.g.:
Description : Catastrophic failure
HelpContext : 5000000
HelpFile :
NativeError :
Number : -2147418113
Source : Microsoft JET Database Engine
SQLState :
The (experimental) C<blob_read> method ignores the C<$offset> argument for
long fields (ADO maintains a I<current offset> internally). To ensure that
C<blob_read> reads from the beginning, C<LongReadLen> must be set to C<0>.
=head1 CAVEATS
=head2 Character set
Proper Unicode support depends on all components involved in your
application: the DBMS, the ADO provider, Perl and some perl modules.
In short: Perl 5.8 and Win32::OLE 0.16 (or later) are strongly
recommended and Win32::OLE has to be prepared to use the correct
codepage:
Win32::OLE->Option( CP => Win32::OLE::CP_UTF8 );
More detailed notes can be found at
http://purl.net/stefan_ram/pub/perl_unicode_en
=head2 ADO providers
=over
=item SQLOLEDB may truncate inserted strings
It seems that the size of the first inserted string is sticky.
Inserted strings longer than the first one are truncated.
As a workaround, the C<ado_size> attribute for C<bind_param> was
introduced in version 2.95:
$sth->bind_param( $p_num, $bind_value, { ado_size => $size } );
=item MSDAORA may have problems with client-side cursors
MSDAORA may throw an error, return an empty result set or loop forever
when C<CursorLocation> is set to C<adUseClient>.
This setting is used in catalog methods for sorting and filtering.
=back
=head1 AUTHORS
Tim Bunce and Phlip. With many thanks to Jan Dubois and Jochen Wiedmann
for additions, debuggery and general help.
Special thanks to Thomas Lowery, who maintained this module 2001-2003.
Current maintainer is Steffen Goeldner.
=head1 SUPPORT
This software is supported via the dbi-users mailing list.
For more information and to keep informed about progress you can join the
mailing list by sending a message to dbi-users-help@perl.org
Please post details of any problems (or changes you needed to make) to
dbi-users@perl.org and CC them to me (sgoeldner@cpan.org).
=head1 COPYRIGHT
Copyright (c) 1998, Tim Bunce
Copyright (c) 1999, Tim Bunce, Phlip, Thomas Lowery
Copyright (c) 2000, Tim Bunce, Thomas Lowery
Copyright (c) 2001, Tim Bunce, Thomas Lowery, Steffen Goeldner
Copyright (c) 2002, Thomas Lowery, Steffen Goeldner
Copyright (c) 2003, Thomas Lowery, Steffen Goeldner
Copyright (c) 2004-2011 Steffen Goeldner
All rights reserved.
You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.
=head1 SEE ALSO
=head2 Books
ADO Reference book: ADO 2.0 Programmer's Reference
David Sussman and Alex Homer
Wrox
ISBN 1-861001-83-5
ADO: ActiveX Data Objects
Jason T. Roff
O'Reilly
ISBN 1-56592-415-0
http://www.oreilly.com/catalog/ado/index.html
If there's anything better please let me know.
=head2 Perl modules
( run in 0.514 second using v1.01-cache-2.11-cpan-39bf76dae61 )