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