| 1 | { |
| 2 | package DBD::NullP; |
| 3 | |
| 4 | require DBI; |
| 5 | |
| 6 | @EXPORT = qw(); # Do NOT @EXPORT anything. |
| 7 | $VERSION = substr(q$Revision: 10.4 $, 9,-1); |
| 8 | |
| 9 | # $Id: NullP.pm,v 10.4 2001/05/29 23:25:55 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 default_user { |
| 32 | return ('',''); |
| 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 disconnect_all { } |
| 43 | sub DESTROY { undef } |
| 44 | } |
| 45 | |
| 46 | |
| 47 | { package DBD::NullP::db; # ====== DATABASE ====== |
| 48 | $imp_data_size = 0; |
| 49 | use strict; |
| 50 | |
| 51 | sub prepare { |
| 52 | my($dbh, $statement)= @_; |
| 53 | |
| 54 | my($outer, $sth) = DBI::_new_sth($dbh, { |
| 55 | 'Statement' => $statement, |
| 56 | }, [ qw'example implementors private data']); |
| 57 | |
| 58 | $outer; |
| 59 | } |
| 60 | |
| 61 | sub FETCH { |
| 62 | my ($dbh, $attrib) = @_; |
| 63 | # In reality this would interrogate the database engine to |
| 64 | # either return dynamic values that cannot be precomputed |
| 65 | # or fetch and cache attribute values too expensive to prefetch. |
| 66 | return 1 if $attrib eq 'AutoCommit'; |
| 67 | # else pass up to DBI to handle |
| 68 | return $dbh->DBD::_::db::FETCH($attrib); |
| 69 | } |
| 70 | |
| 71 | sub STORE { |
| 72 | my ($dbh, $attrib, $value) = @_; |
| 73 | # would normally validate and only store known attributes |
| 74 | # else pass up to DBI to handle |
| 75 | if ($attrib eq 'AutoCommit') { |
| 76 | return 1 if $value; # is already set |
| 77 | croak("Can't disable AutoCommit"); |
| 78 | } |
| 79 | return $dbh->DBD::_::db::STORE($attrib, $value); |
| 80 | } |
| 81 | |
| 82 | sub DESTROY { undef } |
| 83 | } |
| 84 | |
| 85 | |
| 86 | { package DBD::NullP::st; # ====== STATEMENT ====== |
| 87 | $imp_data_size = 0; |
| 88 | use strict; |
| 89 | |
| 90 | sub execute { |
| 91 | my($sth, $dir) = @_; |
| 92 | $sth->{dbd_nullp_data} = $dir if $dir; |
| 93 | 1; |
| 94 | } |
| 95 | |
| 96 | sub fetch { |
| 97 | my($sth) = @_; |
| 98 | my $data = $sth->{dbd_nullp_data}; |
| 99 | if ($data) { |
| 100 | $sth->{dbd_nullp_data} = undef; |
| 101 | return [ $data ]; |
| 102 | } |
| 103 | $sth->finish; # no more data so finish |
| 104 | return undef; |
| 105 | } |
| 106 | |
| 107 | sub finish { |
| 108 | my($sth) = @_; |
| 109 | } |
| 110 | |
| 111 | sub FETCH { |
| 112 | my ($sth, $attrib) = @_; |
| 113 | # would normally validate and only fetch known attributes |
| 114 | # else pass up to DBI to handle |
| 115 | return [ "fieldname" ] if $attrib eq 'NAME'; |
| 116 | return $sth->DBD::_::st::FETCH($attrib); |
| 117 | } |
| 118 | |
| 119 | sub STORE { |
| 120 | my ($sth, $attrib, $value) = @_; |
| 121 | # would normally validate and only store known attributes |
| 122 | # else pass up to DBI to handle |
| 123 | return $sth->DBD::_::st::STORE($attrib, $value); |
| 124 | } |
| 125 | |
| 126 | sub DESTROY { undef } |
| 127 | } |
| 128 | |
| 129 | 1; |