[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package 2 DBI; # hide this non-DBI package from simple indexers 3 4 # $Id: W32ODBC.pm 8696 2007-01-24 23:12:38Z timbo $ 5 # 6 # Copyright (c) 1997,1999 Tim Bunce 7 # With many thanks to Patrick Hollins for polishing. 8 # 9 # You may distribute under the terms of either the GNU General Public 10 # License or the Artistic License, as specified in the Perl README file. 11 12 =head1 NAME 13 14 DBI::W32ODBC - An experimental DBI emulation layer for Win32::ODBC 15 16 =head1 SYNOPSIS 17 18 use DBI::W32ODBC; 19 20 # apart from the line above everything is just the same as with 21 # the real DBI when using a basic driver with few features. 22 23 =head1 DESCRIPTION 24 25 This is an experimental pure perl DBI emulation layer for Win32::ODBC 26 27 If you can improve this code I'd be interested in hearing about it. If 28 you are having trouble using it please respect the fact that it's very 29 experimental. Ideally fix it yourself and send me the details. 30 31 =head2 Some Things Not Yet Implemented 32 33 Most attributes including PrintError & RaiseError. 34 type_info and table_info 35 36 Volunteers welcome! 37 38 =cut 39 40 ${'DBI::VERSION'} # hide version from PAUSE indexer 41 = "0.01"; 42 43 my $Revision = sprintf("12.%06d", q$Revision: 8696 $ =~ /(\d+)/o); 44 45 46 sub DBI::W32ODBC::import { } # must trick here since we're called DBI/W32ODBC.pm 47 48 49 use Carp; 50 51 use Win32::ODBC; 52 53 @ISA = qw(Win32::ODBC); 54 55 use strict; 56 57 $DBI::dbi_debug = $ENV{PERL_DBI_DEBUG} || 0; 58 carp "Loaded (W32ODBC) DBI.pm ${'DBI::VERSION'} (debug $DBI::dbi_debug)" 59 if $DBI::dbi_debug; 60 61 62 63 sub connect { 64 my ($class, $dbname, $dbuser, $dbpasswd, $module, $attr) = @_; 65 $dbname .= ";UID=$dbuser" if $dbuser; 66 $dbname .= ";PWD=$dbpasswd" if $dbpasswd; 67 my $h = new Win32::ODBC $dbname; 68 warn "Error connecting to $dbname: ".Win32::ODBC::Error()."\n" unless $h; 69 bless $h, $class if $h; # rebless into our class 70 $h; 71 } 72 73 74 sub quote { 75 my ($h, $string) = @_; 76 return "NULL" if !defined $string; 77 $string =~ s/'/''/g; # standard 78 # This hack seems to be required for Access but probably breaks for 79 # other databases when using \r and \n. It would be better if we could 80 # use ODBC options to detect that we're actually using Access. 81 $string =~ s/\r/' & chr\$(13) & '/g; 82 $string =~ s/\n/' & chr\$(10) & '/g; 83 "'$string'"; 84 } 85 86 sub do { 87 my($h, $statement, $attribs, @params) = @_; 88 Carp::carp "\$h->do() attribs unused" if $attribs; 89 my $new_h = $h->prepare($statement) or return undef; ## 90 pop @{ $h->{'___sths'} }; ## certian death assured 91 $new_h->execute(@params) or return undef; ## 92 my $rows = $new_h->rows; ## 93 $new_h->finish; ## bang bang 94 ($rows == 0) ? "0E0" : $rows; 95 } 96 97 # --- 98 99 sub prepare { 100 my ($h, $sql) = @_; 101 ## opens a new connection with every prepare to allow 102 ## multiple, concurrent queries 103 my $new_h = new Win32::ODBC $h->{DSN}; ## 104 return undef if not $new_h; ## bail if no connection 105 bless $new_h; ## shouldn't be sub-classed... 106 $new_h->{'__prepare'} = $sql; ## 107 $new_h->{NAME} = []; ## 108 $new_h->{NUM_OF_FIELDS} = -1; ## 109 push @{ $h->{'___sths'} } ,$new_h; ## save sth in parent for mass destruction 110 return $new_h; ## 111 } 112 113 sub execute { 114 my ($h) = @_; 115 my $rc = $h->Sql($h->{'__prepare'}); 116 return undef if $rc; 117 my @fields = $h->FieldNames; 118 $h->{NAME} = \@fields; 119 $h->{NUM_OF_FIELDS} = scalar @fields; 120 $h; # return dbh as pseudo sth 121 } 122 123 124 sub fetchrow_hashref { ## provide DBI compatibility 125 my $h = shift; 126 my $NAME = shift || "NAME"; 127 my $row = $h->fetchrow_arrayref or return undef; 128 my %hash; 129 @hash{ @{ $h->{$NAME} } } = @$row; 130 return \%hash; 131 } 132 133 sub fetchrow { 134 my $h = shift; 135 return unless $h->FetchRow(); 136 my $fields_r = $h->{NAME}; 137 return $h->Data(@$fields_r); 138 } 139 sub fetch { 140 my @row = shift->fetchrow; 141 return undef unless @row; 142 return \@row; 143 } 144 *fetchrow_arrayref = \&fetch; ## provide DBI compatibility 145 *fetchrow_array = \&fetchrow; ## provide DBI compatibility 146 147 sub rows { 148 shift->RowCount; 149 } 150 151 sub finish { 152 shift->Close; ## uncommented this line 153 } 154 155 # --- 156 157 sub commit { 158 shift->Transact(ODBC::SQL_COMMIT); 159 } 160 sub rollback { 161 shift->Transact(ODBC::SQL_ROLLBACK); 162 } 163 164 sub disconnect { 165 my ($h) = shift; ## this will kill all the statement handles 166 foreach (@{$h->{'___sths'}}) { ## created for a specific connection 167 $_->Close if $_->{DSN}; ## 168 } ## 169 $h->Close; ## 170 } 171 172 sub err { 173 (shift->Error)[0]; 174 } 175 sub errstr { 176 scalar( shift->Error ); 177 } 178 179 # --- 180 181 1;
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 |