[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 { 2 package DBD::NullP; 3 4 require DBI; 5 require Carp; 6 7 @EXPORT = qw(); # Do NOT @EXPORT anything. 8 $VERSION = sprintf("12.%06d", q$Revision: 9215 $ =~ /(\d+)/o); 9 10 # $Id: NullP.pm 9215 2007-03-08 17:03:58Z timbo $ 11 # 12 # Copyright (c) 1994-2007 Tim Bunce 13 # 14 # You may distribute under the terms of either the GNU General Public 15 # License or the Artistic License, as specified in the Perl README file. 16 17 $drh = undef; # holds driver handle once initialised 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 41 sub connect { # normally overridden, but a handy default 42 my $dbh = shift->SUPER::connect(@_) 43 or return; 44 $dbh->STORE(Active => 1); 45 $dbh; 46 } 47 48 49 sub DESTROY { undef } 50 } 51 52 53 { package DBD::NullP::db; # ====== DATABASE ====== 54 $imp_data_size = 0; 55 use strict; 56 use Carp qw(croak); 57 58 sub prepare { 59 my ($dbh, $statement)= @_; 60 61 my ($outer, $sth) = DBI::_new_sth($dbh, { 62 'Statement' => $statement, 63 }); 64 65 return $outer; 66 } 67 68 sub FETCH { 69 my ($dbh, $attrib) = @_; 70 # In reality this would interrogate the database engine to 71 # either return dynamic values that cannot be precomputed 72 # or fetch and cache attribute values too expensive to prefetch. 73 return $dbh->SUPER::FETCH($attrib); 74 } 75 76 sub STORE { 77 my ($dbh, $attrib, $value) = @_; 78 # would normally validate and only store known attributes 79 # else pass up to DBI to handle 80 if ($attrib eq 'AutoCommit') { 81 Carp::croak("Can't disable AutoCommit") unless $value; 82 # convert AutoCommit values to magic ones to let DBI 83 # know that the driver has 'handled' the AutoCommit attribute 84 $value = ($value) ? -901 : -900; 85 } 86 return $dbh->SUPER::STORE($attrib, $value); 87 } 88 89 sub ping { 1 } 90 91 sub disconnect { 92 shift->STORE(Active => 0); 93 } 94 95 } 96 97 98 { package DBD::NullP::st; # ====== STATEMENT ====== 99 $imp_data_size = 0; 100 use strict; 101 102 sub bind_param { 103 my ($sth, $param, $value, $attr) = @_; 104 $sth->{ParamValues}{$param} = $value; 105 $sth->{ParamAttr}{$param} = $attr 106 if defined $attr; # attr is sticky if not explicitly set 107 return 1; 108 } 109 110 sub execute { 111 my $sth = shift; 112 $sth->bind_param($_, $_[$_-1]) for (1..@_); 113 if ($sth->{Statement} =~ m/^ \s* SELECT \s+/xmsi) { 114 $sth->STORE(NUM_OF_FIELDS => 1); 115 $sth->{NAME} = [ "fieldname" ]; 116 # just for the sake of returning something, we return the params 117 my $params = $sth->{ParamValues} || {}; 118 $sth->{dbd_nullp_data} = [ @{$params}{ sort keys %$params } ]; 119 $sth->STORE(Active => 1); 120 } 121 1; 122 } 123 124 sub fetchrow_arrayref { 125 my $sth = shift; 126 my $data = $sth->{dbd_nullp_data}; 127 if (!$data || !@$data) { 128 $sth->finish; # no more data so finish 129 return undef; 130 } 131 return $sth->_set_fbav(shift @$data); 132 } 133 *fetch = \&fetchrow_arrayref; # alias 134 135 sub FETCH { 136 my ($sth, $attrib) = @_; 137 # would normally validate and only fetch known attributes 138 # else pass up to DBI to handle 139 return $sth->SUPER::FETCH($attrib); 140 } 141 142 sub STORE { 143 my ($sth, $attrib, $value) = @_; 144 # would normally validate and only store known attributes 145 # else pass up to DBI to handle 146 return $sth->SUPER::STORE($attrib, $value); 147 } 148 149 } 150 151 1;
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |