home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / DBD / Sponge.pm < prev   
Encoding:
Text File  |  1997-08-10  |  1.9 KB  |  100 lines
  1. {
  2.     package DBD::Sponge;
  3.  
  4.     require DBI;
  5.  
  6.     @EXPORT = qw(); # Do NOT @EXPORT anything.
  7.  
  8. #   $Id: Sponge.pm,v 1.1 1995/11/11 18:17:57 timbo Exp $
  9. #
  10. #   Copyright (c) 1994, Tim Bunce
  11. #
  12. #   You may distribute under the terms of either the GNU General Public
  13. #   License or the Artistic License, as specified in the Perl README file.
  14.  
  15.     $drh = undef;    # holds driver handle once initialised
  16.     $err = 0;        # The $DBI::err value
  17.  
  18.     sub driver{
  19.     return $drh if $drh;
  20.     my($class, $attr) = @_;
  21.     $class .= "::dr";
  22.     ($drh) = DBI::_new_drh($class, {
  23.         'Name' => 'Sponge',
  24.         'Version' => '$Revision: 1.1 $',
  25.         'Attribution' => 'DBD Sponge (fake cursor driver) by Tim Bunce',
  26.         });
  27.     $drh;
  28.     }
  29.  
  30.     1;
  31. }
  32.  
  33.  
  34. {   package DBD::Sponge::dr; # ====== DRIVER ======
  35.     $imp_data_size = 0;
  36.     # we use default (dummy) connect method
  37.     sub disconnect_all { }
  38.     sub DESTROY { }
  39. }
  40.  
  41.  
  42. {   package DBD::Sponge::db; # ====== DATABASE ======
  43.     $imp_data_size = 0;
  44.     use strict;
  45.  
  46.     sub prepare {
  47.     my($dbh, $statement, $attribs) = @_;
  48.  
  49.     my($outer, $sth) = DBI::_new_sth($dbh, {
  50.         'Statement'   => $statement,
  51.         'rows'        => $attribs->{'rows'},
  52.         });
  53.  
  54.     $outer;
  55.     }
  56.  
  57.     sub DESTROY { }
  58. }
  59.  
  60.  
  61. {   package DBD::Sponge::st; # ====== STATEMENT ======
  62.     $imp_data_size = 0;
  63.     use strict;
  64.  
  65.     sub execute {
  66.     my($sth, $dir) = @_;
  67.     1;
  68.     }
  69.  
  70.     sub fetch {
  71.     my($sth) = @_;
  72.     my $row = shift(@{$sth->{'rows'}});
  73.     return $row if $row;
  74.     $sth->finish;     # no more data so finish
  75.     return undef;
  76.     }
  77.  
  78.     sub finish {
  79.     my($sth) = @_;
  80.     }
  81.  
  82.     sub FETCH {
  83.     my ($sth, $attrib) = @_;
  84.     # would normally validate and only fetch known attributes
  85.     # else pass up to DBI to handle
  86.     return $sth->DBD::_::dr::FETCH($attrib);
  87.     }
  88.  
  89.     sub STORE {
  90.     my ($sth, $attrib, $value) = @_;
  91.     # would normally validate and only store known attributes
  92.     # else pass up to DBI to handle
  93.     return $sth->DBD::_::dr::STORE($attrib, $value);
  94.     }
  95.  
  96.     sub DESTROY { }
  97. }
  98.  
  99. 1;
  100.