diff options
Diffstat (limited to 'lib/Win32/DBIODBC.pm')
| -rw-r--r-- | lib/Win32/DBIODBC.pm | 248 |
1 files changed, 248 insertions, 0 deletions
diff --git a/lib/Win32/DBIODBC.pm b/lib/Win32/DBIODBC.pm new file mode 100644 index 0000000..a93f69b --- /dev/null +++ b/lib/Win32/DBIODBC.pm @@ -0,0 +1,248 @@ +package # hide this package from CPAN indexer + Win32::ODBC; + +#use strict; + +use DBI; + +# once we've been loaded we don't want perl to load the real Win32::ODBC +$INC{'Win32/ODBC.pm'} = $INC{'Win32/DBIODBC.pm'} || 1; + +#my $db = new Win32::ODBC("DSN=$self->{'DSN'};UID=$self->{'UID'};PWD=$self->{'PWD'};"); + +#EMU --- my $db = new Win32::ODBC("DSN=$DSN;UID=$login;PWD=$password;"); +sub new +{ + shift; + my $connect_line= shift; + +# [R] self-hack to allow empty UID and PWD + my $temp_connect_line; + $connect_line=~/DSN=\w+/; + $temp_connect_line="$&;"; + if ($connect_line=~/UID=\w?/) + {$temp_connect_line.="$&;";} + else {$temp_connect_line.="UID=;";}; + if ($connect_line=~/PWD=\w?/) + {$temp_connect_line.="$&;";} + else {$temp_connect_line.="PWD=;";}; + $connect_line=$temp_connect_line; +# -[R]- + + my $self= {}; + + + $_=$connect_line; + /^(DSN=)(.*)(;UID=)(.*)(;PWD=)(.*)(;)$/; + + #---- DBI CONNECTION VARIABLES + + $self->{ODBC_DSN}=$2; + $self->{ODBC_UID}=$4; + $self->{ODBC_PWD}=$6; + + + #---- DBI CONNECTION VARIABLES + $self->{DBI_DBNAME}=$self->{ODBC_DSN}; + $self->{DBI_USER}=$self->{ODBC_UID}; + $self->{DBI_PASSWORD}=$self->{ODBC_PWD}; + $self->{DBI_DBD}='ODBC'; + + #---- DBI CONNECTION + $self->{'DBI_DBH'}=DBI->connect($self->{'DBI_DBNAME'}, + $self->{'DBI_USER'},$self->{'DBI_PASSWORD'},$self->{'DBI_DBD'}); + + warn "Error($DBI::err) : $DBI::errstr\n" if ! $self->{'DBI_DBH'}; + + + #---- RETURN + + bless $self; +} + + +#EMU --- $db->Sql('SELECT * FROM DUAL'); +sub Sql +{ + my $self= shift; + my $SQL_statment=shift; + + # print " SQL : $SQL_statment \n"; + + $self->{'DBI_SQL_STATMENT'}=$SQL_statment; + + my $dbh=$self->{'DBI_DBH'}; + + # print " DBH : $dbh \n"; + + my $sth=$dbh->prepare("$SQL_statment"); + + # print " STH : $sth \n"; + + $self->{'DBI_STH'}=$sth; + + if ($sth) + { + $sth->execute(); + } + + #--- GET ERROR MESSAGES + $self->{DBI_ERR}=$DBI::err; + $self->{DBI_ERRSTR}=$DBI::errstr; + + if ($sth) + { + #--- GET COLUMNS NAMES + $self->{'DBI_NAME'} = $sth->{NAME}; + } + +# [R] provide compatibility with Win32::ODBC's way of identifying erraneous SQL statements + return ($self->{'DBI_ERR'})?1:undef; +# -[R]- +} + + +#EMU --- $db->FetchRow()) +sub FetchRow +{ + my $self= shift; + + my $sth=$self->{'DBI_STH'}; + if ($sth) + { + my @row=$sth->fetchrow_array; + $self->{'DBI_ROW'}=\@row; + + if (scalar(@row)>0) + { + #-- the row of result is not nul + #-- return somthing nothing will be return else + return 1; + } + } + return undef; +} + +# [R] provide compatibility with Win32::ODBC's Data() method. +sub Data +{ + my $self=shift; + my @array=@{$self->{'DBI_ROW'}}; + foreach my $element (@array) + { + # remove padding of spaces by DBI + $element=~s/(\s*$)//; + }; + return (wantarray())?@array:join('', @array); +}; +# -[R]- + +#EMU --- %record = $db->DataHash; +sub DataHash +{ + my $self= shift; + + my $p_name=$self->{'DBI_NAME'}; + my $p_row=$self->{'DBI_ROW'}; + + my @name=@$p_name; + my @row=@$p_row; + + my %DataHash; +#print @name; print "\n"; print @row; +# [R] new code that seems to work consistent with Win32::ODBC + while (@name) + { + my $name=shift(@name); + my $value=shift(@row); + + # remove padding of spaces by DBI + $name=~s/(\s*$)//; + $value=~s/(\s*$)//; + + $DataHash{$name}=$value; + }; +# -[R]- + +# [R] old code that didn't appear to work +# foreach my $name (@name) +# { +# $name=~s/(^\s*)|(\s*$)//; +# my @arr=@$name; +# foreach (@arr) +# { +# print "lot $name name col $_ or ROW= 0 $row[0] 1 $row[1] 2 $row[2] \n "; +# $DataHash{$name}=shift(@row); +# } +# } +# -[R]- + + #--- Return Hash + return %DataHash; +} + + +#EMU --- $db->Error() +sub Error +{ + my $self= shift; + + if ($self->{'DBI_ERR'} ne '') + { + #--- Return error message + $self->{'DBI_ERRSTR'}; + } + + #-- else good no error message + +} + +# [R] provide compatibility with Win32::ODBC's Close() method. +sub Close +{ + my $self=shift; + + my $dbh=$self->{'DBI_DBH'}; + $dbh->disconnect; +} +# -[R]- + +1; + +__END__ + +# [R] to -[R]- indicate sections edited by me, Roy Lee + +=head1 NAME + +Win32::DBIODBC - Win32::ODBC emulation layer for the DBI + +=head1 SYNOPSIS + + use Win32::DBIODBC; # instead of use Win32::ODBC + +=head1 DESCRIPTION + +This is a I<very> basic I<very> alpha quality Win32::ODBC emulation +for the DBI. To use it just replace + + use Win32::ODBC; + +in your scripts with + + use Win32::DBIODBC; + +or, while experimenting, you can pre-load this module without changing your +scripts by doing + + perl -MWin32::DBIODBC your_script_name + +=head1 TO DO + +Error handling is virtually non-existent. + +=head1 AUTHOR + +Tom Horen <tho@melexis.com> + +=cut |