Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package # hide this package from CPAN indexer |
2 | Win32::ODBC; | |
3 | ||
4 | #use strict; | |
5 | ||
6 | use 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;"); | |
14 | sub 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'); | |
65 | sub 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()) | |
106 | sub 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. | |
127 | sub 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; | |
141 | sub 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() | |
186 | sub 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. | |
201 | sub Close | |
202 | { | |
203 | my $self=shift; | |
204 | ||
205 | my $dbh=$self->{'DBI_DBH'}; | |
206 | $dbh->disconnect; | |
207 | } | |
208 | # -[R]- | |
209 | ||
210 | 1; | |
211 | ||
212 | __END__ | |
213 | ||
214 | # [R] to -[R]- indicate sections edited by me, Roy Lee | |
215 | ||
216 | =head1 NAME | |
217 | ||
218 | Win32::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 | ||
226 | This is a I<very> basic I<very> alpha quality Win32::ODBC emulation | |
227 | for the DBI. To use it just replace | |
228 | ||
229 | use Win32::ODBC; | |
230 | ||
231 | in your scripts with | |
232 | ||
233 | use Win32::DBIODBC; | |
234 | ||
235 | or, while experimenting, you can pre-load this module without changing your | |
236 | scripts by doing | |
237 | ||
238 | perl -MWin32::DBIODBC your_script_name | |
239 | ||
240 | =head1 TO DO | |
241 | ||
242 | Error handling is virtually non-existant. | |
243 | ||
244 | =head1 AUTHOR | |
245 | ||
246 | Tom Horen <tho@melexis.com> | |
247 | ||
248 | =cut |