diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
commit | 316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch) | |
tree | cb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl/lib/DBI/W32ODBC.pm | |
parent | cd0f87b5d39480d85ad9bd4ee37f520f75bed560 (diff) |
Moving old tlperl prior to committing new one
git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/DBI/W32ODBC.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/DBI/W32ODBC.pm | 181 |
1 files changed, 0 insertions, 181 deletions
diff --git a/Master/tlpkg/tlperl/lib/DBI/W32ODBC.pm b/Master/tlpkg/tlperl/lib/DBI/W32ODBC.pm deleted file mode 100755 index ac2aea11699..00000000000 --- a/Master/tlpkg/tlperl/lib/DBI/W32ODBC.pm +++ /dev/null @@ -1,181 +0,0 @@ -package - DBI; # hide this non-DBI package from simple indexers - -# $Id: W32ODBC.pm 8696 2007-01-24 23:12:38Z timbo $ -# -# Copyright (c) 1997,1999 Tim Bunce -# With many thanks to Patrick Hollins for polishing. -# -# You may distribute under the terms of either the GNU General Public -# License or the Artistic License, as specified in the Perl README file. - -=head1 NAME - -DBI::W32ODBC - An experimental DBI emulation layer for Win32::ODBC - -=head1 SYNOPSIS - - use DBI::W32ODBC; - - # apart from the line above everything is just the same as with - # the real DBI when using a basic driver with few features. - -=head1 DESCRIPTION - -This is an experimental pure perl DBI emulation layer for Win32::ODBC - -If you can improve this code I'd be interested in hearing about it. If -you are having trouble using it please respect the fact that it's very -experimental. Ideally fix it yourself and send me the details. - -=head2 Some Things Not Yet Implemented - - Most attributes including PrintError & RaiseError. - type_info and table_info - -Volunteers welcome! - -=cut - -${'DBI::VERSION'} # hide version from PAUSE indexer - = "0.01"; - -my $Revision = sprintf("12.%06d", q$Revision: 8696 $ =~ /(\d+)/o); - - -sub DBI::W32ODBC::import { } # must trick here since we're called DBI/W32ODBC.pm - - -use Carp; - -use Win32::ODBC; - -@ISA = qw(Win32::ODBC); - -use strict; - -$DBI::dbi_debug = $ENV{PERL_DBI_DEBUG} || 0; -carp "Loaded (W32ODBC) DBI.pm ${'DBI::VERSION'} (debug $DBI::dbi_debug)" - if $DBI::dbi_debug; - - - -sub connect { - my ($class, $dbname, $dbuser, $dbpasswd, $module, $attr) = @_; - $dbname .= ";UID=$dbuser" if $dbuser; - $dbname .= ";PWD=$dbpasswd" if $dbpasswd; - my $h = new Win32::ODBC $dbname; - warn "Error connecting to $dbname: ".Win32::ODBC::Error()."\n" unless $h; - bless $h, $class if $h; # rebless into our class - $h; -} - - -sub quote { - my ($h, $string) = @_; - return "NULL" if !defined $string; - $string =~ s/'/''/g; # standard - # This hack seems to be required for Access but probably breaks for - # other databases when using \r and \n. It would be better if we could - # use ODBC options to detect that we're actually using Access. - $string =~ s/\r/' & chr\$(13) & '/g; - $string =~ s/\n/' & chr\$(10) & '/g; - "'$string'"; -} - -sub do { - my($h, $statement, $attribs, @params) = @_; - Carp::carp "\$h->do() attribs unused" if $attribs; - my $new_h = $h->prepare($statement) or return undef; ## - pop @{ $h->{'___sths'} }; ## certian death assured - $new_h->execute(@params) or return undef; ## - my $rows = $new_h->rows; ## - $new_h->finish; ## bang bang - ($rows == 0) ? "0E0" : $rows; -} - -# --- - -sub prepare { - my ($h, $sql) = @_; - ## opens a new connection with every prepare to allow - ## multiple, concurrent queries - my $new_h = new Win32::ODBC $h->{DSN}; ## - return undef if not $new_h; ## bail if no connection - bless $new_h; ## shouldn't be sub-classed... - $new_h->{'__prepare'} = $sql; ## - $new_h->{NAME} = []; ## - $new_h->{NUM_OF_FIELDS} = -1; ## - push @{ $h->{'___sths'} } ,$new_h; ## save sth in parent for mass destruction - return $new_h; ## -} - -sub execute { - my ($h) = @_; - my $rc = $h->Sql($h->{'__prepare'}); - return undef if $rc; - my @fields = $h->FieldNames; - $h->{NAME} = \@fields; - $h->{NUM_OF_FIELDS} = scalar @fields; - $h; # return dbh as pseudo sth -} - - -sub fetchrow_hashref { ## provide DBI compatibility - my $h = shift; - my $NAME = shift || "NAME"; - my $row = $h->fetchrow_arrayref or return undef; - my %hash; - @hash{ @{ $h->{$NAME} } } = @$row; - return \%hash; -} - -sub fetchrow { - my $h = shift; - return unless $h->FetchRow(); - my $fields_r = $h->{NAME}; - return $h->Data(@$fields_r); -} -sub fetch { - my @row = shift->fetchrow; - return undef unless @row; - return \@row; -} -*fetchrow_arrayref = \&fetch; ## provide DBI compatibility -*fetchrow_array = \&fetchrow; ## provide DBI compatibility - -sub rows { - shift->RowCount; -} - -sub finish { - shift->Close; ## uncommented this line -} - -# --- - -sub commit { - shift->Transact(ODBC::SQL_COMMIT); -} -sub rollback { - shift->Transact(ODBC::SQL_ROLLBACK); -} - -sub disconnect { - my ($h) = shift; ## this will kill all the statement handles - foreach (@{$h->{'___sths'}}) { ## created for a specific connection - $_->Close if $_->{DSN}; ## - } ## - $h->Close; ## -} - -sub err { - (shift->Error)[0]; -} -sub errstr { - scalar( shift->Error ); -} - -# --- - -1; |