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
CommitLineData
86530b38
AT
1package # hide this package from CPAN indexer
2 Win32::ODBC;
3
4#use strict;
5
6use DBI;
7
8# once we've been loaded we don't want perl to load the real Win32::ODBC
9$INC{'Win32/ODBC.pm'} = $INC{'Win32/DBIODBC.pm'} || 1;
10
11#my $db = new Win32::ODBC("DSN=$self->{'DSN'};UID=$self->{'UID'};PWD=$self->{'PWD'};");
12
13#EMU --- my $db = new Win32::ODBC("DSN=$DSN;UID=$login;PWD=$password;");
14sub new
15{
16 shift;
17 my $connect_line= shift;
18
19# [R] self-hack to allow empty UID and PWD
20 my $temp_connect_line;
21 $connect_line=~/DSN=\w+/;
22 $temp_connect_line="$&;";
23 if ($connect_line=~/UID=\w?/)
24 {$temp_connect_line.="$&;";}
25 else {$temp_connect_line.="UID=;";};
26 if ($connect_line=~/PWD=\w?/)
27 {$temp_connect_line.="$&;";}
28 else {$temp_connect_line.="PWD=;";};
29 $connect_line=$temp_connect_line;
30# -[R]-
31
32 my $self= {};
33
34
35 $_=$connect_line;
36 /^(DSN=)(.*)(;UID=)(.*)(;PWD=)(.*)(;)$/;
37
38 #---- DBI CONNECTION VARIABLES
39
40 $self->{ODBC_DSN}=$2;
41 $self->{ODBC_UID}=$4;
42 $self->{ODBC_PWD}=$6;
43
44
45 #---- DBI CONNECTION VARIABLES
46 $self->{DBI_DBNAME}=$self->{ODBC_DSN};
47 $self->{DBI_USER}=$self->{ODBC_UID};
48 $self->{DBI_PASSWORD}=$self->{ODBC_PWD};
49 $self->{DBI_DBD}='ODBC';
50
51 #---- DBI CONNECTION
52 $self->{'DBI_DBH'}=DBI->connect($self->{'DBI_DBNAME'},
53 $self->{'DBI_USER'},$self->{'DBI_PASSWORD'},$self->{'DBI_DBD'});
54
55 warn "Error($DBI::err) : $DBI::errstr\n" if ! $self->{'DBI_DBH'};
56
57
58 #---- RETURN
59
60 bless $self;
61}
62
63
64#EMU --- $db->Sql('SELECT * FROM DUAL');
65sub Sql
66{
67 my $self= shift;
68 my $SQL_statment=shift;
69
70 # print " SQL : $SQL_statment \n";
71
72 $self->{'DBI_SQL_STATMENT'}=$SQL_statment;
73
74 my $dbh=$self->{'DBI_DBH'};
75
76 # print " DBH : $dbh \n";
77
78 my $sth=$dbh->prepare("$SQL_statment");
79
80 # print " STH : $sth \n";
81
82 $self->{'DBI_STH'}=$sth;
83
84 if ($sth)
85 {
86 $sth->execute();
87 }
88
89 #--- GET ERROR MESSAGES
90 $self->{DBI_ERR}=$DBI::err;
91 $self->{DBI_ERRSTR}=$DBI::errstr;
92
93 if ($sth)
94 {
95 #--- GET COLUMNS NAMES
96 $self->{'DBI_NAME'} = $sth->{NAME};
97 }
98
99# [R] provide compatibility with Win32::ODBC's way of identifying erraneous SQL statements
100 return ($self->{'DBI_ERR'})?1:undef;
101# -[R]-
102}
103
104
105#EMU --- $db->FetchRow())
106sub FetchRow
107{
108 my $self= shift;
109
110 my $sth=$self->{'DBI_STH'};
111 if ($sth)
112 {
113 my @row=$sth->fetchrow_array;
114 $self->{'DBI_ROW'}=\@row;
115
116 if (scalar(@row)>0)
117 {
118 #-- the row of result is not nul
119 #-- return somthing nothing will be return else
120 return 1;
121 }
122 }
123 return undef;
124}
125
126# [R] provide compatibility with Win32::ODBC's Data() method.
127sub Data
128{
129 my $self=shift;
130 my @array=@{$self->{'DBI_ROW'}};
131 foreach my $element (@array)
132 {
133 # remove padding of spaces by DBI
134 $element=~s/(\s*$)//;
135 };
136 return (wantarray())?@array:join('', @array);
137};
138# -[R]-
139
140#EMU --- %record = $db->DataHash;
141sub DataHash
142{
143 my $self= shift;
144
145 my $p_name=$self->{'DBI_NAME'};
146 my $p_row=$self->{'DBI_ROW'};
147
148 my @name=@$p_name;
149 my @row=@$p_row;
150
151 my %DataHash;
152#print @name; print "\n"; print @row;
153# [R] new code that seems to work consistent with Win32::ODBC
154 while (@name)
155 {
156 my $name=shift(@name);
157 my $value=shift(@row);
158
159 # remove padding of spaces by DBI
160 $name=~s/(\s*$)//;
161 $value=~s/(\s*$)//;
162
163 $DataHash{$name}=$value;
164 };
165# -[R]-
166
167# [R] old code that didn't appear to work
168# foreach my $name (@name)
169# {
170# $name=~s/(^\s*)|(\s*$)//;
171# my @arr=@$name;
172# foreach (@arr)
173# {
174# print "lot $name name col $_ or ROW= 0 $row[0] 1 $row[1] 2 $row[2] \n ";
175# $DataHash{$name}=shift(@row);
176# }
177# }
178# -[R]-
179
180 #--- Return Hash
181 return %DataHash;
182}
183
184
185#EMU --- $db->Error()
186sub Error
187{
188 my $self= shift;
189
190 if ($self->{'DBI_ERR'} ne '')
191 {
192 #--- Return error message
193 $self->{'DBI_ERRSTR'};
194 }
195
196 #-- else good no error message
197
198}
199
200# [R] provide compatibility with Win32::ODBC's Close() method.
201sub Close
202{
203 my $self=shift;
204
205 my $dbh=$self->{'DBI_DBH'};
206 $dbh->disconnect;
207}
208# -[R]-
209
2101;
211
212__END__
213
214# [R] to -[R]- indicate sections edited by me, Roy Lee
215
216=head1 NAME
217
218Win32::DBIODBC - Win32::ODBC emulation layer for the DBI
219
220=head1 SYNOPSIS
221
222 use Win32::DBIODBC; # instead of use Win32::ODBC
223
224=head1 DESCRIPTION
225
226This is a I<very> basic I<very> alpha quality Win32::ODBC emulation
227for the DBI. To use it just replace
228
229 use Win32::ODBC;
230
231in your scripts with
232
233 use Win32::DBIODBC;
234
235or, while experimenting, you can pre-load this module without changing your
236scripts by doing
237
238 perl -MWin32::DBIODBC your_script_name
239
240=head1 TO DO
241
242Error handling is virtually non-existant.
243
244=head1 AUTHOR
245
246Tom Horen <tho@melexis.com>
247
248=cut