On Mon Sep 21 22:13:30 2009, ickphum wrote:
Show quoted text> We've found a problem with data that exceeds the limit for varchar fields.
The attached patch (incl. test case) resolves the issue for me, does it
also work for you?
Also available here:
http://github.com/pilcrow/perl-dbd-interbase/tree/rt49896
diff --git a/dbdimp.c b/dbdimp.c
index bafb9a2..8e3fb50 100644
--- a/dbdimp.c
+++ b/dbdimp.c
@@ -2179,53 +2179,36 @@ static int ib_fill_isqlda(SV *sth, imp_sth_t *imp_sth, SV *param, SV *value,
case SQL_VARYING:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_VARYING\n"));
{
- char buf[25]; /* long long can have max 20 chars. */
- char *tmp = NULL;
+ char *string;
+
if (ivar->sqldata == (char *) NULL)
{
if ((ivar->sqldata = (char *)safemalloc(
- sizeof(char) * (ivar->sqllen + 1) + sizeof(short))) == NULL)
+ sizeof(char) * ivar->sqllen + sizeof(short))) == NULL)
{
do_error(sth, 2, "Cannot allocate buffer for VARCHAR input parameter \n");
retval = FALSE;
break;
}
}
- if (SvIOK(value)) {
- tmp = buf;
- len = sprintf(tmp, "%d", (int)SvIV(value));
- }
- else if (SvNOK(value)) {
- tmp = buf;
- len = sprintf(tmp, "%f", SvNV(value));
- }
- else if (SvPOK(value) || (SvTYPE(value) == SVt_PVMG)) {
- len = SvCUR(value);
- tmp = SvPV_nolen(value);
- }
- else {
- /* error */
- do_error(sth, 2, "Cannot cast to VARCHAR input parameter\n");
- retval = FALSE;
- break;
- }
+
+ string = SvPV(value, len);
/* The first word of VARCHAR sqldata is the length */
*((short *) ivar->sqldata) = len;
- /* is the scalar longer than the database field? */
- if (len > (sizeof(char) * (ivar->sqllen+1)))
+ /* is the scalar longer than the database field? */
+ if (len > (sizeof(char) * ivar->sqllen))
{
char err[80];
sprintf(err, "You are trying to put %d characters into a %d character field",
- len, (sizeof(char) * (ivar->sqllen + 1)));
+ len, (sizeof(char) * ivar->sqllen));
do_error(sth, 2, err);
retval = FALSE;
}
else
{
- memcpy(ivar->sqldata + sizeof(short), tmp, len);
- ivar->sqldata[len + sizeof(short)] = '\0';
+ memcpy(ivar->sqldata + sizeof(short), string, len);
}
break;
@@ -2234,8 +2217,7 @@ static int ib_fill_isqlda(SV *sth, imp_sth_t *imp_sth, SV *param, SV *value,
case SQL_TEXT:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_TEXT\n"));
{
- char buf[25]; /* long long can have max 20 chars. */
- char *tmp;
+ char *string;
if (ivar->sqldata == (char *) NULL)
{
@@ -2247,39 +2229,23 @@ static int ib_fill_isqlda(SV *sth, imp_sth_t *imp_sth, SV *param, SV *value,
break;
}
}
- if (SvIOK(value)) {
- tmp = buf;
- len = sprintf(tmp, "%d", (int)SvIV(value));
- }
- else if (SvNOK(value)) {
- tmp = buf;
- len = sprintf(tmp, "%f", SvNV(value));
- }
- else if (SvPOK(value) || (SvTYPE(value) == SVt_PVMG)) {
- len = SvCUR(value);
- tmp = SvPV_nolen(value);
- }
- else {
- /* error */
- do_error(sth, 2, "Cannot cast to TEXT input parameter\n");
- retval = FALSE;
- break;
- }
+
+ string = SvPV(value, len);
/* is the scalar longer than the database field? */
- if (len > (sizeof(char) * (ivar->sqllen+1)))
+ if (len > (sizeof(char) * ivar->sqllen))
{
/* error? or truncate? */
char err[80];
sprintf(err, "You are trying to put %d characters into a %d character field",
- len, (sizeof(char) * (ivar->sqllen+1)));
+ len, (sizeof(char) * ivar->sqllen));
do_error(sth, 2, err);
retval = FALSE;
}
else
{
memset(ivar->sqldata, ' ', ivar->sqllen);
- memcpy(ivar->sqldata, tmp, len);
+ memcpy(ivar->sqldata, string, len);
}
break;
diff --git a/t/rt49896.t b/t/rt49896.t
new file mode 100644
index 0000000..d5e99b5
--- /dev/null
+++ b/t/rt49896.t
@@ -0,0 +1,73 @@
+#!/usr/local/bin/perl -w
+#
+# Test cases for DBD-InterBase rt.cpan.org #49896
+# "Varchar fields accept data one char over field length (but memory
+# is corrupted)"
+#
+
+use strict;
+use DBI;
+use Test::More tests => 8;
+use vars qw( $dbh $table );
+
+END {
+ if (defined($dbh) and $table) {
+ eval { $dbh->do("DROP TABLE $table"); };
+ $dbh->disconnect;
+ }
+}
+
+# Make -w happy
+$::test_dsn = '';
+$::test_user = '';
+$::test_password = '';
+
+my $file;
+do {
+ if (-f ($file = "t/InterBase.dbtest") ||
+ -f ($file = "InterBase.dbtest"))
+ {
+ eval { require $file };
+ if ($@) {
+ diag("Cannot execute $file: $@\n");
+ exit 0;
+ }
+ }
+};
+
+sub find_new_table {
+ my $dbh = shift;
+ my $try_name = 'GGG';
+ my %tables = map { uc($_) => 1 } $dbh->tables;
+ while (exists $tables{$try_name}) {
+ ++$try_name;
+ }
+ $try_name;
+}
+
+# ------- TESTS ------------------------------------------------------------- #
+
+$dbh = DBI->connect($::test_dsn, $::test_user, $::test_password);
+ok($dbh);
+
+$table = find_new_table($dbh);
+ok($table);
+
+ok($dbh->do("CREATE TABLE $table( c1 varchar(3) )",
+ "CREATE TABLE $table(...)"));
+
+ok($dbh->do("INSERT INTO GGG(c1) VALUES(?)", undef, 'aa'),
+ "INSERT string (length < column size) succeeds");
+
+ok($dbh->do("INSERT INTO GGG(c1) VALUES(?)", undef, 'aaa'),
+ "INSERT string (length == column size) succeeds");
+
+$dbh->{PrintError} = 0;
+
+ok(! defined $dbh->do("INSERT INTO GGG(c1) VALUES(?)", undef, 'aaa!'),
+ "INSERT string (length == column size + 1) fails");
+
+ok(! defined $dbh->do("INSERT INTO GGG(c1) VALUES(?)", undef, 'aaa!!'),
+ "INSERT string (length == column size + 2) fails");
+
+ok($dbh->do("DROP TABLE $table"), "DROP TABLE $table");
