r3065 - in /packages/libdbd-mysql-perl/branches/upstream/current:
ChangeLog MANIFEST META.yml dbdimp.c eg/ eg/prepare_memory_usage.pl
eg/proc_example1.pl eg/proc_example2.pl eg/proc_example3.pl
lib/DBD/mysql.pm mysql.xs
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Sat Jun 17 12:41:27 UTC 2006
Author: gregoa-guest
Date: Sat Jun 17 12:41:26 2006
New Revision: 3065
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3065
Log:
Load /tmp/tmp.auRGeC9650/libdbd-mysql-perl-3.0006 into
packages/libdbd-mysql-perl/branches/upstream/current.
Added:
packages/libdbd-mysql-perl/branches/upstream/current/eg/
packages/libdbd-mysql-perl/branches/upstream/current/eg/prepare_memory_usage.pl (with props)
packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example1.pl (with props)
packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example2.pl (with props)
packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example3.pl (with props)
Modified:
packages/libdbd-mysql-perl/branches/upstream/current/ChangeLog
packages/libdbd-mysql-perl/branches/upstream/current/MANIFEST
packages/libdbd-mysql-perl/branches/upstream/current/META.yml
packages/libdbd-mysql-perl/branches/upstream/current/dbdimp.c
packages/libdbd-mysql-perl/branches/upstream/current/lib/DBD/mysql.pm
packages/libdbd-mysql-perl/branches/upstream/current/mysql.xs
Modified: packages/libdbd-mysql-perl/branches/upstream/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/ChangeLog?rev=3065&op=diff
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/ChangeLog (original)
+++ packages/libdbd-mysql-perl/branches/upstream/current/ChangeLog Sat Jun 17 12:41:26 2006
@@ -1,3 +1,13 @@
+2006-06-10 Patrick Galbraith <patg at mysql.com) (3.0005)
+ * Fix dbd_st_finish in 3.0004 didn't clean up bind buffers resulting in
+ a memory leak. See eg/prepare_memory_usage.pl to see how this manifests
+ itself. Thanks to Jason Snell for giving me a good script to reproduce
+ this!
+ * Fix to parse_params, mysql.xs dbh->do, and bind_param to deal with
+ passing substr to "do" for placeholder value. Thanks Martin Waite for
+ the patch to parse_params (extended to mysql.xs "do" and bind_param for
+ server-side prepared statements.
+
2006-05-17 Patrick Galbraith <patg at mysql.com) (3.0004)
* Fix dbd_st_finish which closed the handle prematurely (Martin Evans)
* Compile issues (Martin Evans)
Modified: packages/libdbd-mysql-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/MANIFEST?rev=3065&op=diff
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libdbd-mysql-perl/branches/upstream/current/MANIFEST Sat Jun 17 12:41:26 2006
@@ -28,6 +28,10 @@
lib/Bundle/DBD/mysql.pm
lib/Mysql/Statement.pm
lib/Mysql.pm
+eg/prepare_memory_usage.pl
+eg/proc_example1.pl
+eg/proc_example2.pl
+eg/proc_example3.pl
TODO
myld
constants.h
Modified: packages/libdbd-mysql-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/META.yml?rev=3065&op=diff
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/META.yml (original)
+++ packages/libdbd-mysql-perl/branches/upstream/current/META.yml Sat Jun 17 12:41:26 2006
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: DBD-mysql
-version: 3.0004
+version: 3.0006
version_from: lib/DBD/mysql.pm
installdirs: site
requires:
Modified: packages/libdbd-mysql-perl/branches/upstream/current/dbdimp.c
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/dbdimp.c?rev=3065&op=diff
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/dbdimp.c (original)
+++ packages/libdbd-mysql-perl/branches/upstream/current/dbdimp.c Sat Jun 17 12:41:26 2006
@@ -437,7 +437,15 @@
for (i= 0, ph= params; i < num_params; i++, ph++)
{
- if (!ph->value || !SvOK(ph->value))
+ int defined= 0;
+ if (ph->value)
+ {
+ if (SvMAGICAL(ph->value))
+ mg_get(ph->value);
+ if (SvOK(ph->value))
+ defined=1;
+ }
+ if (!defined)
alen+= 3; /* Erase '?', insert 'NULL' */
else
{
@@ -637,9 +645,12 @@
int bind_param(imp_sth_ph_t *ph, SV *value, IV sql_type)
{
if (ph->value)
+ {
+ if (SvMAGICAL(ph->value))
+ mg_get(ph->value);
(void) SvREFCNT_dec(ph->value);
-
- ph->value = newSVsv(value);
+ }
+ ph->value= newSVsv(value);
if (sql_type)
ph->type = sql_type;
@@ -3031,6 +3042,35 @@
return 0;
}
}
+ /* clean up other statement allocations */
+ if (DBIc_NUM_PARAMS(imp_sth) > 0)
+ {
+ if (dbis->debug >= 2)
+ PerlIO_printf(DBILOGFP,
+ "\tFreeing %d parameters\n",
+ DBIc_NUM_PARAMS(imp_sth));
+ FreeBind(imp_sth->bind);
+ FreeFBind(imp_sth->fbind);
+ imp_sth->bind= NULL;
+ imp_sth->fbind= NULL;
+ }
+ num_fields= DBIc_NUM_FIELDS(imp_sth);
+
+ if (imp_sth->fbh)
+ {
+ num_fields= DBIc_NUM_FIELDS(imp_sth);
+
+ for (fbh= imp_sth->fbh, i= 0; i < num_fields; i++, fbh++)
+ {
+ if (fbh->data)
+ Safefree(fbh->data);
+ }
+ FreeFBuffer(imp_sth->fbh);
+ FreeBind(imp_sth->buffer);
+ imp_sth->buffer= NULL;
+ imp_sth->fbh= NULL;
+ }
+
}
#endif
Added: packages/libdbd-mysql-perl/branches/upstream/current/eg/prepare_memory_usage.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/eg/prepare_memory_usage.pl?rev=3065&op=file
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/eg/prepare_memory_usage.pl (added)
+++ packages/libdbd-mysql-perl/branches/upstream/current/eg/prepare_memory_usage.pl Sat Jun 17 12:41:26 2006
@@ -1,0 +1,30 @@
+#!/usr/bin/perl -w
+
+use strict;
+use DBI;
+
+my $ssp = 1;
+my $count = 0;
+
+my $query = "SELECT 1 FROM DUAL";
+
+my $dbh = DBI->connect (
+ "dbi:mysql:database=test:host=localhost;mysql_emulated_prepare=0",
+ "root", "",
+ { RaiseError => 1, PrintError => 0 },
+ );
+
+my $s_q = $dbh->prepare($query);
+
+while (1) {
+ $s_q->execute();
+ my @data = $s_q->fetchrow_array();
+ $s_q->finish;
+
+ $count++;
+
+ print "ran $count queries\r";
+
+ sleep(0.3);
+}
+
Propchange: packages/libdbd-mysql-perl/branches/upstream/current/eg/prepare_memory_usage.pl
------------------------------------------------------------------------------
svn:executable = *
Added: packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example1.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example1.pl?rev=3065&op=file
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example1.pl (added)
+++ packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example1.pl Sat Jun 17 12:41:26 2006
@@ -1,0 +1,47 @@
+#!/usr/bin/perl
+
+use DBI;
+
+$DATABASE='test';
+$HOST='localhost';
+$PORT=3306; $USER='root';
+$PASSWORD='';
+
+$dbh = DBI->connect("DBI:mysql:$DATABASE:$HOST:$PORT",
+ "$USER", "$PASSWORD",
+ { PrintError => 0}) || die $DBI::errstr;
+
+ $dbh->do("drop procedure if exists testproc") or print $DBI::errstr;
+
+ $dbh->do("create procedure testproc() deterministic
+ begin
+ declare a,b,c,d int;
+ set a=1;
+ set b=2;
+ set c=3;
+ set d=4;
+ select a, b, c, d;
+ select d, c, b, a;
+ select b, a, c, d;
+ select c, b, d, a;
+ end") or print $DBI::errstr;
+
+ $sth=$dbh->prepare('call testproc()') ||
+ die $DBI::err.": ".$DBI::errstr;
+
+ $sth->execute || die DBI::err.": ".$DBI::errstr; $rowset=0;
+ do {
+ print "\nRowset ".++$i."\n---------------------------------------\n\n";
+ foreach $colno (0..$sth->{NUM_OF_FIELDS}) {
+ print $sth->{NAME}->[$colno]."\t";
+ }
+ print "\n";
+ while (@row= $sth->fetchrow_array()) {
+ foreach $field (0..$#row) {
+ print $row[$field]."\t";
+ }
+ print "\n";
+ }
+ } until (!$sth->more_results)
+
+
Propchange: packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example1.pl
------------------------------------------------------------------------------
svn:executable = *
Added: packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example2.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example2.pl?rev=3065&op=file
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example2.pl (added)
+++ packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example2.pl Sat Jun 17 12:41:26 2006
@@ -1,0 +1,54 @@
+#!/usr/bin/perl
+
+use DBI;
+
+$DATABASE='test';
+$HOST='localhost';
+$PORT=3306; $USER='root';
+$PASSWORD='';
+
+#DBI->trace(3);
+$dbh = DBI->connect("DBI:mysql:$DATABASE:$HOST:$PORT",
+ "$USER", "$PASSWORD",
+ { PrintError => 0}) || die $DBI::errstr;
+
+# DROP TABLE IF EXISTS
+$dbh->do("DROP TABLE IF EXISTS users") or print $DBI::errstr;
+# CREATE TABLE
+$dbh->do("CREATE TABLE users (id INT, name VARCHAR(32))") or print $DBI::errstr;
+
+my $sth= $dbh->prepare("INSERT INTO users VALUES (?, ?)");
+
+for $i(1 .. 20) {
+ my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
+ my $random_chars = join '', map { $chars[rand @chars] } 0 .. 31;
+
+ my $rows = $sth->execute($i, $random_chars);
+}
+
+$dbh->do("DROP PROCEDURE IF EXISTS users_proc") or print $DBI::errstr;
+
+$dbh->do("CREATE PROCEDURE users_proc() DETERMINISTIC
+BEGIN
+ SELECT id, name FROM users;
+END") or print $DBI::errstr;
+
+$sth = $dbh->prepare('call users_proc()') ||
+ die $DBI::err.": ".$DBI::errstr;
+
+ $sth->execute || die DBI::err.": ".$DBI::errstr; $rowset=0;
+ do {
+ print "\nRowset ".++$i."\n---------------------------------------\n\n";
+ foreach $colno (0..$sth->{NUM_OF_FIELDS}) {
+ print $sth->{NAME}->[$colno]."\t";
+ }
+ print "\n";
+ while (@row=$sth->fetchrow_array()) {
+ foreach $field (0..$#row) {
+ print $row[$field]."\t";
+ }
+ print "\n";
+ }
+ } until (!$sth->more_results)
+
+
Propchange: packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example2.pl
------------------------------------------------------------------------------
svn:executable = *
Added: packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example3.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example3.pl?rev=3065&op=file
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example3.pl (added)
+++ packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example3.pl Sat Jun 17 12:41:26 2006
@@ -1,0 +1,53 @@
+#!/usr/bin/perl
+
+use DBI;
+
+$DATABASE='test';
+$HOST='localhost';
+$PORT=3306; $USER='root';
+$PASSWORD='';
+
+$dbh = DBI->connect("DBI:mysql:$DATABASE:$HOST:$PORT",
+ "$USER", "$PASSWORD",
+ { PrintError => 0}) || die $DBI::errstr;
+$dbh->trace(3, "./dbd.log");
+
+ $dbh->do("drop procedure if exists testproc") or print $DBI::errstr;
+
+ $dbh->do("create procedure testproc() deterministic
+ begin
+ declare a,b,c,d,e,f int;
+ set a=1;
+ set b=2;
+ set c=3;
+ set d=4;
+ set e=5;
+ set f=6;
+ select a, b, c, d;
+ select d, c, b, a;
+ select b, a, c, d;
+ select c, b, d, a;
+ select a, d;
+ select a, b, c, d, e, f;
+ select f;
+ end") or print $DBI::errstr;
+
+ $sth=$dbh->prepare('call testproc()') ||
+ die $DBI::err.": ".$DBI::errstr;
+
+ $sth->execute || die DBI::err.": ".$DBI::errstr; $rowset=0;
+ do {
+ print "\nRowset ".++$i."\n---------------------------------------\n\n";
+ foreach $colno (0..$sth->{NUM_OF_FIELDS}) {
+ print $sth->{NAME}->[$colno]."\t";
+ }
+ print "\n";
+ while (@row= $sth->fetchrow_array()) {
+ foreach $field (0..$#row) {
+ print $row[$field]."\t";
+ }
+ print "\n";
+ }
+ } until (!$sth->more_results)
+
+
Propchange: packages/libdbd-mysql-perl/branches/upstream/current/eg/proc_example3.pl
------------------------------------------------------------------------------
svn:executable = *
Modified: packages/libdbd-mysql-perl/branches/upstream/current/lib/DBD/mysql.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/lib/DBD/mysql.pm?rev=3065&op=diff
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/lib/DBD/mysql.pm (original)
+++ packages/libdbd-mysql-perl/branches/upstream/current/lib/DBD/mysql.pm Sat Jun 17 12:41:26 2006
@@ -9,7 +9,7 @@
use Carp ();
@ISA = qw(DynaLoader);
-$VERSION = '3.0004';
+$VERSION = '3.0006';
bootstrap DBD::mysql $VERSION;
Modified: packages/libdbd-mysql-perl/branches/upstream/current/mysql.xs
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdbd-mysql-perl/branches/upstream/current/mysql.xs?rev=3065&op=diff
==============================================================================
--- packages/libdbd-mysql-perl/branches/upstream/current/mysql.xs (original)
+++ packages/libdbd-mysql-perl/branches/upstream/current/mysql.xs Sat Jun 17 12:41:26 2006
@@ -294,9 +294,17 @@
for (i = 0; i < numParams; i++)
{
+ int defined= 0;
params[i].value = ST(i+3);
- if ((SvOK(params[i].value) && params[i].value))
+ if (params[i].value)
+ {
+ if (SvMAGICAL(params[i].value))
+ mg_get(params[i].value);
+ if (SvOK(params[i].value))
+ defined= 1;
+ }
+ if (defined)
{
buffer = SvPV(params[i].value, slen);
buffer_is_null = 0;
More information about the Pkg-perl-cvs-commits
mailing list