home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / DBI / W32ODBC.pm < prev   
Encoding:
Perl POD Document  |  1997-08-10  |  3.2 KB  |  168 lines
  1. package DBI;
  2.  
  3. # $Id: W32ODBC.pm,v 1.3 1997/06/11 23:03:50 timbo Exp $
  4. #
  5. # Copyright (c) 1997, Tim Bunce
  6. #
  7. # You may distribute under the terms of either the GNU General Public
  8. # License or the Artistic License, as specified in the Perl README file.
  9.  
  10. =head1 NAME
  11.  
  12. DBI::W32ODBC - An experimental DBI emulation layer for Win32::ODBC
  13.  
  14. =head1 SYNOPSIS
  15.  
  16.   use DBI::W32ODBC;
  17.  
  18.   # apart from the line above everything is just the same as with
  19.   # the real DBI when using a basic driver with few features.
  20.  
  21.   $dbh = DBI->connect(...);
  22.  
  23.   $rc  = $dbh->do($statement);
  24.  
  25.   $sth = $dbh->prepare($statement);
  26.  
  27.   $rc = $sth->execute;
  28.  
  29.   @row_ary = $sth->fetchrow;
  30.   $row_ref = $sth->fetch;
  31.  
  32.   $rc = $sth->finish;
  33.  
  34.   $rv = $sth->rows;
  35.  
  36.   $rc = $dbh->disconnect;
  37.  
  38.   $sql = $dbh->quote($string);
  39.  
  40.   $rv  = $h->err;
  41.   $str = $h->errstr;
  42.  
  43. =head1 DESCRIPTION
  44.  
  45. THIS IS A VERY EXPERIMENTAL PURE PERL DBI EMULATION LAYER FOR Win32::ODBC
  46.  
  47. It was developed for use with an Access database and the quote() method
  48. is very likely to need reworking.
  49.  
  50. If you can improve this code I'd be interested in hearing out it. If
  51. you are having trouble using it please respect the fact that it's very
  52. experimental.
  53.  
  54. =cut
  55.  
  56. $VERSION = $VERSION = '0.01';
  57. my $Revision = substr(q$Revision: 1.3 $, 10);
  58.  
  59. sub DBI::W32ODBC::import { }        # must trick here since we're called DBI/W32ODBC.pm
  60.  
  61.  
  62. use Carp;
  63.  
  64. use Win32::ODBC;
  65.  
  66. @ISA = qw(Win32::ODBC);
  67.  
  68. use strict;
  69.  
  70. $DBI::dbi_debug = $ENV{PERL_DBI_DEBUG} || 0;
  71. carp "Loaded DBI.pm (debug $DBI::dbi_debug)" if $DBI::dbi_debug;
  72.  
  73.  
  74.  
  75. sub connect {
  76.     my ($class, $dbname, $dbuser, $dbpasswd, $module, $attr) = @_;
  77.     $dbname .= ";UID=$dbuser"   if $dbuser;
  78.     $dbname .= ";PWD=$dbpasswd" if $dbpasswd;
  79.     my $h = new Win32::ODBC $dbname;
  80.     warn "Error connecting to $dbname: ".Win32::ODBC::Error()."\n" unless $h;
  81.     bless $h, $class if $h;    # rebless into our class
  82.     $h;
  83. }
  84.  
  85.  
  86. sub quote {
  87.     my ($h, $string) = @_;
  88.     # don't know if this is correct but seems to work for Access
  89.     $string =~ s/'/''/g;
  90.     $string =~ s/\r/' & chr\$(13) & '/g;
  91.     $string =~ s/\n/' & chr\$(10) & '/g;
  92.     "'$string'";
  93. }
  94.  
  95. sub do {
  96.     my($h, $statement, $attribs, @params) = @_;
  97.     Carp::carp "\$h->do() attribs unused\n" if $attribs;
  98.     $h = $h->prepare($statement) or return undef;
  99.     $h->execute(@params) or return undef;
  100.     my $rows = $h->rows;
  101.     ($rows == 0) ? "0E0" : $rows;
  102. }
  103.  
  104. # ---
  105.  
  106. sub prepare {
  107.     my ($h, $sql) = @_;
  108.     $h->{'__prepare'} = $sql;
  109.     $h->{NAME} = [];
  110.     $h->{NUM_OF_FIELDS} = -1;
  111.     return $h;
  112. }
  113.  
  114. sub execute {
  115.     my ($h) = @_;
  116.     my $rc = $h->Sql($h->{'__prepare'});
  117.     return undef if $rc;
  118.     my @fields = $h->FieldNames;
  119.     $h->{NAME} = \@fields;
  120.     $h->{NUM_OF_FIELDS} = scalar @fields;
  121.     $h;    # return dbh as pseudo sth
  122. }
  123.  
  124. sub fetchrow {
  125.     my $h = shift;
  126.     return () unless $h->FetchRow();
  127.     my $fields_r = $h->{NAME};
  128.     $h->Data(@$fields_r);
  129. }
  130.  
  131. sub fetch {
  132.     my @row = shift->fetchrow;
  133.     return undef unless @row;
  134.     return \@row;
  135. }
  136.  
  137. sub rows {
  138.     shift->RowCount;
  139. }
  140.  
  141. sub finish {
  142.     # shift->Close;
  143. }
  144.  
  145. # ---
  146.  
  147. sub commit {
  148.     undef;
  149. }
  150. sub rollback {
  151.     undef;
  152. }
  153.  
  154. sub disconnect {
  155.     shift->Close
  156. }
  157.  
  158. sub err {
  159.     (shift->Error)[0];
  160. }
  161. sub errstr {
  162.     scalar( shift->Error );
  163. }
  164.  
  165. # ---
  166.  
  167. 1;
  168.