Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
API	[ DIR ]	drwxrwxrwx	2024-07-26 17:39
Console	[ DIR ]	drwxrwxrwx	2024-07-26 17:39
Exe	[ DIR ]	drwxrwxrwx	2024-07-26 17:39
File	[ DIR ]	drwxrwxrwx	2024-07-26 17:39
GuiTest	[ DIR ]	drwxrwxrwx	2024-07-26 17:39
OLE	[ DIR ]	drwxrwxrwx	2024-07-26 17:39
API.pm	50.44 KB	-rw-rw-rw-	2016-01-21 21:49
Clipboard.pm	7.87 KB	-rw-rw-rw-	2013-12-11 22:39
Console.pm	36.88 KB	-rw-rw-rw-	2013-11-28 22:13
DBIODBC.pm	4.43 KB	-rw-rw-rw-	2015-05-26 19:26
Daemon.pm	35.61 KB	-rw-rw-rw-	2020-07-28 05:48
EventLog.pm	12.77 KB	-rw-rw-rw-	2013-12-07 01:00
Exe.pm	23.46 KB	-rw-rw-rw-	2011-07-20 01:50
File.pm	1.83 KB	-rw-rw-rw-	2013-11-28 22:49
GuiTest.pm	49.81 KB	-rw-rw-rw-	2019-08-16 12:50
IPHelper.pm	74.36 KB	-rw-rw-rw-	2011-10-24 11:23
Job.pm	10.09 KB	-rw-rw-rw-	2013-11-29 00:13
OLE.pm	33.38 KB	-rw-rw-rw-	2014-05-15 02:39
Pipe.pm	10.29 KB	-rw-rw-rw-	2013-12-05 02:12
Process.pm	5.52 KB	-rw-rw-rw-	2013-12-12 00:36
SerialPort.pm	89.02 KB	-rw-rw-rw-	2010-06-11 05:37
Service.pm	2.15 KB	-rw-rw-rw-	2013-12-06 22:20
ServiceManager.pm	17.64 KB	-rw-rw-rw-	2018-08-01 04:08
ShellQuote.pm	5.84 KB	-rw-rw-rw-	2016-09-27 08:33
TieRegistry.pm	120.32 KB	-rw-rw-rw-	2016-02-02 19:50
UTCFileTime.pm	67.8 KB	-rw-rw-rw-	2020-12-23 12:52
WinError.pm	23.08 KB	-rw-rw-rw-	2013-12-06 22:36

Rename

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]-

__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