Author: turnstep
Date: Tue Jan 8 11:06:41 2008
New Revision: 10495
Modified:
DBD-Pg/trunk/Changes
DBD-Pg/trunk/Pg.pm
DBD-Pg/trunk/dbdimp.c
DBD-Pg/trunk/dbdimp.h
DBD-Pg/trunk/t/01setup.t
DBD-Pg/trunk/t/03smethod.t
Log:
Very experimental support for bind_param_inout.
Modified: DBD-Pg/trunk/Changes
==============================================================================
--- DBD-Pg/trunk/Changes (original)
+++ DBD-Pg/trunk/Changes Tue Jan 8 11:06:41 2008
@@ -1,6 +1,8 @@
('GSM' is Greg Sabino Mullane, [EMAIL PROTECTED])
2.0.0
+ - Very experimental support for bind_param_inout, use
+ with caution. [GSM]
- Switch from pow to powf to support AIX compiler issue.
(CPAN bug #24579) [GSM]
- Use adbin, not adsrc, when figuring out the sequence name for the
Modified: DBD-Pg/trunk/Pg.pm
==============================================================================
--- DBD-Pg/trunk/Pg.pm (original)
+++ DBD-Pg/trunk/Pg.pm Tue Jan 8 11:06:41 2008
@@ -2875,7 +2875,27 @@
=item B<bind_param_inout>
-Currently not supported by this driver.
+Experimental support for this feature is provided. The first argument to
+bind_param_inout should be a placeholder number. The second argument
+should be a reference to a scalar variable in your script. The third argument
+is not used and should simply be set to 0. Note that what this really does is
+assign a returned column to the variable, in the order in which the column
+appears. For example:
+
+ my $foo = 123;
+ $sth = $dbh->prepare("SELECT 1+?::int");
+ $sth->bind_param_inout(1, \$foo, 0);
+ $foo = 222;
+ $sth->execute(444);
+ $sth->fetch;
+
+The above will cause $foo to have a new value of "223" after the final fetch.
+Note that the variables bound in this manner are very sticky, and will trump
any
+values passed in to execute. This is because the binding is done as late as
possible,
+at the execute() stage, allowing the value to be changed between the time it
was bound
+and the time the query is executed. Thus, the above execute is the same as:
+
+ $sth->execute();
=item B<bind_param_array>
Modified: DBD-Pg/trunk/dbdimp.c
==============================================================================
--- DBD-Pg/trunk/dbdimp.c (original)
+++ DBD-Pg/trunk/dbdimp.c Tue Jan 8 11:06:41 2008
@@ -1215,6 +1215,7 @@
imp_sth->has_binary = DBDPG_FALSE; /* Are any of the params
binary? */
imp_sth->has_default = DBDPG_FALSE; /* Are any of the params
DEFAULT? */
imp_sth->has_current = DBDPG_FALSE; /* Are any of the params
DEFAULT? */
+ imp_sth->use_inout = DBDPG_FALSE; /* Are any of the placeholders
using inout? */
/* We inherit some preferences from the database handle */
@@ -1678,6 +1679,7 @@
newph->defaultval = DBDPG_TRUE;
newph->isdefault = DBDPG_FALSE;
newph->iscurrent = DBDPG_FALSE;
+ newph->isinout = DBDPG_FALSE;
Newx(newph->fooname, sectionsize+1, char); /*
freed in dbd_st_destroy */
Copy(statement-sectionsize, newph->fooname,
sectionsize, char);
newph->fooname[sectionsize] = '\0';
@@ -1764,6 +1766,7 @@
newph->defaultval = DBDPG_TRUE;
newph->isdefault = DBDPG_FALSE;
newph->iscurrent = DBDPG_FALSE;
+ newph->isinout = DBDPG_FALSE;
/* Let the correct segment(s) point to it */
for (currseg=imp_sth->seg; NULL != currseg;
currseg=currseg->nextseg) {
if (currseg->placeholder==xint) {
@@ -1958,9 +1961,6 @@
(void)PerlIO_printf(DBILOGFP, "dbdpg: dbd_bind_ph ph_name: (%s)
newvalue: %s(%lu)\n",
neatsvpv(ph_name,0),
neatsvpv(newvalue,0), SvOK(newvalue));
- if (is_inout!=0)
- croak("bind_inout not supported by this driver");
-
if (0==imp_sth->numphs)
croak("Statement has no placeholders to bind");
@@ -2049,6 +2049,12 @@
}
}
+ if (is_inout) {
+ currph->isinout = DBDPG_TRUE;
+ imp_sth->use_inout = DBDPG_TRUE;
+ currph->inout = newvalue; /* Reference to a scalar */
+ }
+
/* We ignore attribs for these special cases */
if (currph->isdefault || currph->iscurrent || is_array) {
if (NULL == currph->bind_type) {
@@ -2541,6 +2547,12 @@
pg_error(sth, PGRES_FATAL_ERROR, "execute
called with an unbound placeholder");
return -2;
}
+ if (currph->isinout) {
+ currph->valuelen = sv_len(currph->inout);
+ Renew(currph->value, currph->valuelen+1, char);
+ Copy(SvPV_nolen(currph->inout), currph->value,
currph->valuelen, char);
+ currph->value[currph->valuelen] = '\0';
+ }
}
}
@@ -3008,7 +3020,18 @@
}
imp_sth->cur_tuple += 1;
-
+
+ /* Experimental inout support */
+ if (imp_sth->use_inout) {
+ ph_t *currph;
+ for (i=0,currph=imp_sth->ph; NULL != currph && i < num_fields;
currph=currph->nextph,i++) {
+ if (currph->isinout) {
+ sv_copypv(currph->inout, AvARRAY(av)[i]);
+ }
+ }
+ }
+
+
return av;
} /* end of dbd_st_fetch */
Modified: DBD-Pg/trunk/dbdimp.h
==============================================================================
--- DBD-Pg/trunk/dbdimp.h (original)
+++ DBD-Pg/trunk/dbdimp.h Tue Jan 8 11:06:41 2008
@@ -63,6 +63,8 @@
bool defaultval; /* is it using a generic 'default' value? */
bool iscurrent; /* is it using a generic 'default' value? */
bool isdefault; /* Are we passing a literal 'DEFAULT'? */
+ bool isinout; /* Is this a bind_param_inout value? */
+ SV *inout; /* What variable we are updating via inout
magic */
sql_type_info_t* bind_type; /* type information for this placeholder */
struct ph_st *nextph; /* more linked list goodness */
};
@@ -101,7 +103,8 @@
bool has_binary; /* does it have one or more binary
placeholders? */
bool has_default; /* does it have one or more 'DEFAULT' values?
*/
bool has_current; /* does it have one or more 'DEFAULT' values?
*/
- bool dollaronly; /* Only use $1 as placeholders, allow all
else */
+ bool dollaronly; /* Only use $1 as placeholders, allow all else
*/
+ bool use_inout; /* Any placeholders using inout? */
};
/* Other (non-static) functions we have added to dbdimp.c */
Modified: DBD-Pg/trunk/t/01setup.t
==============================================================================
--- DBD-Pg/trunk/t/01setup.t (original)
+++ DBD-Pg/trunk/t/01setup.t Tue Jan 8 11:06:41 2008
@@ -78,7 +78,7 @@
testarray text[][],
testarray2 int[],
"CaseTest" boolean,
- bytetest bytea
+ bytetest bytea
)
};
Modified: DBD-Pg/trunk/t/03smethod.t
==============================================================================
--- DBD-Pg/trunk/t/03smethod.t (original)
+++ DBD-Pg/trunk/t/03smethod.t Tue Jan 8 11:06:41 2008
@@ -2,7 +2,6 @@
# Test of the statement handle methods
# The following methods are *not* currently tested here:
-# "bind_param_inout"
# "execute"
# "finish"
# "dump_results"
@@ -13,7 +12,7 @@
$|=1;
if (defined $ENV{DBI_DSN}) {
- plan tests => 57;
+ plan tests => 69;
}
else {
plan skip_all => 'Cannot run test unless DBI_DSN is defined. See the
README file';
@@ -116,6 +115,76 @@
$client_level = $sth2->fetchall_arrayref()->[0][0];
#
+# Test of the "bind_param_inout" statement handle method
+#
+
+my $t = q{Values do not change if bind_param_inout is not called};
+
+my $var = 123;
+$sth = $dbh->prepare("SELECT 1+?::int");
+
+$t = q{Invalid placeholder fails for bind_param_inout};
+eval { $sth->bind_param_inout(0, \$var, 0); };
+like($@, qr{Cannot bind}, $t);
+
+eval { $sth->bind_param_inout(3, \$var, 0); };
+like($@, qr{Cannot bind}, $t);
+
+$t = q{Calling bind_param_inout with a non-scalar reference fails};
+eval { $sth->bind_param_inout(1, "noway", 0); };
+like($@, qr{needs a reference}, $t);
+
+eval { $sth->bind_param_inout(1, $t, 0); };
+like($@, qr{needs a reference}, $t);
+
+eval { $sth->bind_param_inout(1, [123], 0); };
+like($@, qr{needs a reference}, $t);
+
+
+$t = q{Calling bind_param_inout changes an integer value};
+eval { $sth->bind_param_inout(1, \$var, 0); };
+is($@, q{}, $t);
+$var = 999;
+$sth->execute();
+$sth->fetch;
+is($var, 1000, $t);
+
+$t = q{Calling bind_param_inout changes a string value};
+$sth = $dbh->prepare("SELECT 'X'||?::text");
+$sth->bind_param_inout(1, \$var, 0);
+$var = 'abc';
+$sth->execute();
+$sth->fetch;
+is($var, 'Xabc', $t);
+
+$t = q{Calling bind_param_inout changes a string to a float};
+$sth = $dbh->prepare("SELECT ?::float");
+$sth->bind_param_inout(1, \$var, 0);
+$var = '1e+6';
+$sth->execute();
+$sth->fetch;
+is($var, '1000000', $t);
+
+$t = q{Calling bind_param_inout works for second placeholder};
+$sth = $dbh->prepare("SELECT ?::float, 1+?::int");
+$sth->bind_param_inout(2, \$var, 0);
+$var = 111;
+$sth->execute(222,333);
+$sth->fetch;
+is($var, 112, $t);
+
+$t = q{Calling bind_param_inout changes two variables at once};
+my $var2 = 234;
+$sth = $dbh->prepare("SELECT 1+?::float, 1+?::int");
+$sth->bind_param_inout(1, \$var, 0);
+$sth->bind_param_inout(2, \$var2, 0);
+$var = 444; $var2 = 555;
+$sth->execute();
+$sth->fetch;
+is($var, 445, $t);
+is($var2, 556, $t);
+
+#
# Test of the "bind_param_array" statement handle method
#
