package
DBI;
=head1 NAME
DBI::W32ODBC - An experimental DBI emulation layer for Win32::ODBC
=head1 SYNOPSIS
use DBI::W32ODBC;
# apart from the line above everything is just the same as with
# the real DBI when using a basic driver with few features.
=head1 DESCRIPTION
This is an experimental pure perl DBI emulation layer for Win32::ODBC
If you can improve this code I'd be interested in hearing about it. If
you are having trouble using it please respect the fact that it's very
experimental. Ideally fix it yourself and send me the details.
=head2 Some Things Not Yet Implemented
Most attributes including PrintError & RaiseError.
type_info and table_info
Volunteers welcome!
=cut
${'DBI::VERSION'} = "0.01";
my $Revision = sprintf("12.%06d", q$Revision: 8696 $ =~ /(\d+)/o);
sub DBI::W32ODBC::import { }
use Carp;
use Win32::ODBC;
@ISA = qw(Win32::ODBC);
use strict;
$DBI::dbi_debug = $ENV{PERL_DBI_DEBUG} || 0;
carp "Loaded (W32ODBC) DBI.pm ${'DBI::VERSION'} (debug $DBI::dbi_debug)"
if $DBI::dbi_debug;
sub connect {
my ($class, $dbname, $dbuser, $dbpasswd, $module, $attr) = @_;
$dbname .= ";UID=$dbuser" if $dbuser;
$dbname .= ";PWD=$dbpasswd" if $dbpasswd;
my $h = new Win32::ODBC $dbname;
warn "Error connecting to $dbname: ".Win32::ODBC::Error()."\n" unless $h;
bless $h, $class if $h; $h;
}
sub quote {
my ($h, $string) = @_;
return "NULL" if !defined $string;
$string =~ s/'/''/g; # standard
# This hack seems to be required for Access but probably breaks for
# other databases when using \r and \n. It would be better if we could
# use ODBC options to detect that we're actually using Access.
$string =~ s/\r/' & chr\$(13) & '/g;
$string =~ s/\n/' & chr\$(10) & '/g;
"'$string'";
}
sub do {
my($h, $statement, $attribs, @params) = @_;
Carp::carp "\$h->do() attribs unused" if $attribs;
my $new_h = $h->prepare($statement) or return undef; pop @{ $h->{'___sths'} }; $new_h->execute(@params) or return undef; my $rows = $new_h->rows; $new_h->finish; ($rows == 0) ? "0E0" : $rows;
}
sub prepare {
my ($h, $sql) = @_;
my $new_h = new Win32::ODBC $h->{DSN}; return undef if not $new_h; bless $new_h; $new_h->{'__prepare'} = $sql; $new_h->{NAME} = []; $new_h->{NUM_OF_FIELDS} = -1; push @{ $h->{'___sths'} } ,$new_h; return $new_h; }
sub execute {
my ($h) = @_;
my $rc = $h->Sql($h->{'__prepare'});
return undef if $rc;
my @fields = $h->FieldNames;
$h->{NAME} = \@fields;
$h->{NUM_OF_FIELDS} = scalar @fields;
$h; }
sub fetchrow_hashref { my $h = shift;
my $NAME = shift || "NAME";
my $row = $h->fetchrow_arrayref or return undef;
my %hash;
@hash{ @{ $h->{$NAME} } } = @$row;
return \%hash;
}
sub fetchrow {
my $h = shift;
return unless $h->FetchRow();
my $fields_r = $h->{NAME};
return $h->Data(@$fields_r);
}
sub fetch {
my @row = shift->fetchrow;
return undef unless @row;
return \@row;
}
*fetchrow_arrayref = \&fetch; *fetchrow_array = \&fetchrow;
sub rows {
shift->RowCount;
}
sub finish {
shift->Close; }
sub commit {
shift->Transact(ODBC::SQL_COMMIT);
}
sub rollback {
shift->Transact(ODBC::SQL_ROLLBACK);
}
sub disconnect {
my ($h) = shift; foreach (@{$h->{'___sths'}}) { $_->Close if $_->{DSN}; } $h->Close; }
sub err {
(shift->Error)[0];
}
sub errstr {
scalar( shift->Error );
}
1;