JezK
Edit File: DBIODBC.pm
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 erroneous 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 something 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