[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
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
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |