home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / NullP.pm < prev    next >
Encoding:
Text File  |  2004-01-07  |  2.8 KB  |  129 lines
  1. {
  2.     package DBD::NullP;
  3.  
  4.     require DBI;
  5.  
  6.     @EXPORT = qw(); # Do NOT @EXPORT anything.
  7.     $VERSION = sprintf("%d.%02d", q$Revision: 11.4 $ =~ /(\d+)\.(\d+)/o);
  8.  
  9. #   $Id: NullP.pm,v 11.4 2004/01/07 17:38:51 timbo Exp $
  10. #
  11. #   Copyright (c) 1994, Tim Bunce
  12. #
  13. #   You may distribute under the terms of either the GNU General Public
  14. #   License or the Artistic License, as specified in the Perl README file.
  15.  
  16.     $drh = undef;    # holds driver handle once initialised
  17.     $err = 0;        # The $DBI::err value
  18.  
  19.     sub driver{
  20.     return $drh if $drh;
  21.     my($class, $attr) = @_;
  22.     $class .= "::dr";
  23.     ($drh) = DBI::_new_drh($class, {
  24.         'Name' => 'NullP',
  25.         'Version' => $VERSION,
  26.         'Attribution' => 'DBD Example Null Perl stub by Tim Bunce',
  27.         }, [ qw'example implementors private data']);
  28.     $drh;
  29.     }
  30.  
  31.     sub CLONE {
  32.         undef $drh;
  33.     }
  34. }
  35.  
  36.  
  37. {   package DBD::NullP::dr; # ====== DRIVER ======
  38.     $imp_data_size = 0;
  39.     use strict;
  40.     # we use default (dummy) connect method
  41.  
  42.     sub DESTROY { undef }
  43. }
  44.  
  45.  
  46. {   package DBD::NullP::db; # ====== DATABASE ======
  47.     $imp_data_size = 0;
  48.     use strict;
  49.  
  50.     sub prepare {
  51.     my($dbh, $statement)= @_;
  52.  
  53.     my($outer, $sth) = DBI::_new_sth($dbh, {
  54.         'Statement'     => $statement,
  55.         }, [ qw'example implementors private data']);
  56.  
  57.     $outer;
  58.     }
  59.  
  60.     sub FETCH {
  61.     my ($dbh, $attrib) = @_;
  62.     # In reality this would interrogate the database engine to
  63.     # either return dynamic values that cannot be precomputed
  64.     # or fetch and cache attribute values too expensive to prefetch.
  65.     return 1 if $attrib eq 'AutoCommit';
  66.     # else pass up to DBI to handle
  67.     return $dbh->DBD::_::db::FETCH($attrib);
  68.     }
  69.  
  70.     sub STORE {
  71.     my ($dbh, $attrib, $value) = @_;
  72.     # would normally validate and only store known attributes
  73.     # else pass up to DBI to handle
  74.     if ($attrib eq 'AutoCommit') {
  75.         return 1 if $value; # is already set
  76.         croak("Can't disable AutoCommit");
  77.     }
  78.     return $dbh->DBD::_::db::STORE($attrib, $value);
  79.     }
  80.  
  81.     sub DESTROY { undef }
  82. }
  83.  
  84.  
  85. {   package DBD::NullP::st; # ====== STATEMENT ======
  86.     $imp_data_size = 0;
  87.     use strict;
  88.  
  89.     sub execute {
  90.     my($sth, $dir) = @_;
  91.     $sth->{dbd_nullp_data} = $dir if $dir;
  92.     1;
  93.     }
  94.  
  95.     sub fetch {
  96.     my($sth) = @_;
  97.     my $data = $sth->{dbd_nullp_data};
  98.         if ($data) {
  99.         $sth->{dbd_nullp_data} = undef;
  100.         return [ $data ];
  101.     }
  102.     $sth->finish;     # no more data so finish
  103.     return undef;
  104.     }
  105.  
  106.     sub finish {
  107.     my($sth) = @_;
  108.     }
  109.  
  110.     sub FETCH {
  111.     my ($sth, $attrib) = @_;
  112.     # would normally validate and only fetch known attributes
  113.     # else pass up to DBI to handle
  114.     return [ "fieldname" ] if $attrib eq 'NAME';
  115.     return $sth->DBD::_::st::FETCH($attrib);
  116.     }
  117.  
  118.     sub STORE {
  119.     my ($sth, $attrib, $value) = @_;
  120.     # would normally validate and only store known attributes
  121.     # else pass up to DBI to handle
  122.     return $sth->DBD::_::st::STORE($attrib, $value);
  123.     }
  124.  
  125.     sub DESTROY { undef }
  126. }
  127.  
  128. 1;
  129.