Commit | Line | Data |
---|---|---|
86530b38 AT |
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; |