package
DBI;
${
'DBI::VERSION'
}
=
"0.01"
;
my
$Revision
=
sprintf
(
"12.%06d"
,
q$Revision: 8696 $
=~ /(\d+)/o);
sub
DBI::W32ODBC::
import
{ }
@ISA
=
qw(Win32::ODBC)
;
$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;
$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;