Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Win32 / 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 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-existant.

=head1 AUTHOR

Tom Horen <tho@melexis.com>

=cut