(notice that I have an issue with the test, discussed in a separate thread)
Index: lib/DBD/mysql.pm
===================================================================
RCS file: /home/stas/cvs/modules/DBD-mysql/lib/DBD/mysql.pm,v
retrieving revision 1.1
diff -u -r1.1 mysql.pm
--- lib/DBD/mysql.pm 23 Mar 2005 23:07:01 -0000 1.1
+++ lib/DBD/mysql.pm 30 Mar 2005 04:36:16 -0000
@@ -124,10 +124,14 @@
return undef;
}- # Call msqlConnect func in mSQL.xs file
- # and populate internal handle data.
- DBD::mysql::db::_login($this, $dsn, $username, $password)
- or $this = undef;
+ # if dbi_imp_data is passed then we should already have a handle,
+ # with a valid connection
+ unless ($privateAttrHash->{dbi_imp_data}) {
+ # Call msqlConnect func in mSQL.xs file
+ # and populate internal handle data.
+ DBD::mysql::db::_login($this, $dsn, $username, $password)
+ or $this = undef;
+ } if ($this && ($ENV{MOD_PERL} || $ENV{GATEWAY_INTERFACE})) {
$this->{mysql_auto_reconnect} = 1;
Index: dbdimp.c
===================================================================
RCS file: /home/stas/cvs/modules/DBD-mysql/dbdimp.c,v
retrieving revision 1.1
diff -u -r1.1 dbdimp.c
--- dbdimp.c 23 Mar 2005 23:07:00 -0000 1.1
+++ dbdimp.c 30 Mar 2005 04:36:17 -0000
@@ -2455,4 +2455,18 @@
return result;
}+SV *mysql_take_imp_data(SV *h, imp_xxh_t *imp_xxh, void *foo)
+{
+#ifdef dTHR
+ dTHR;
+#endif
+ D_imp_dbh(h);
+
+ DBIc_ACTIVE_off(imp_dbh);
+ if (dbis->debug >= 2)
+ PerlIO_printf(DBILOGFP, "&imp_dbh->mysql: %lx\n",
+ (long) &imp_dbh->mysql);
+
+ return &PL_sv_yes;
+}Index: dbdimp.h =================================================================== RCS file: /home/stas/cvs/modules/DBD-mysql/dbdimp.h,v retrieving revision 1.1 diff -u -r1.1 dbdimp.h --- dbdimp.h 23 Mar 2005 23:07:00 -0000 1.1 +++ dbdimp.h 30 Mar 2005 04:36:17 -0000 @@ -189,6 +189,7 @@ #define do_error mysql_dr_error #define dbd_db_type_info_all mysql_db_type_info_all #define dbd_db_quote mysql_db_quote +#define dbd_take_imp_data mysql_take_imp_data
#include <dbd_xsh.h> void do_error (SV* h, int rc, const char *what);
--- /dev/null 2005-03-22 13:01:45.030128280 -0500
+++ t/70takeimp.t 2005-03-29 19:24:18.000000000 -0500
@@ -0,0 +1,174 @@
+#!/usr/local/bin/perl
+#
+# $Id: 70takeimp.t,v 1.1 2005/03/23 23:07:04 stas Exp $
+#
+# This is a skeleton test. For writing new tests, take this file
+# and modify/extend it.
+#
+
+use strict;
+use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver);
+use DBI ();
+
+#
+# Include lib.pl
+#
+$mdriver = "";
+my $file;
+foreach $file ("lib.pl", "t/lib.pl") {
+ do $file; if ($@) { print STDERR "Error while executing lib.pl: [EMAIL PROTECTED]";
+ exit 10;
+ }
+ if ($mdriver ne '') {
+ last;
+ }
+}
+
+my $drh = DBI->install_driver($mdriver);
+
+sub ServerError() {
+ print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
+ "\tEither your server is not up and running or you have no\n",
+ "\tpermissions for acessing the DSN $test_dsn.\n",
+ "\tThis test requires a running server and write permissions.\n",
+ "\tPlease make sure your server is running and you have\n",
+ "\tpermissions, then retry.\n");
+ exit 10;
+}
+
+#DBI->trace(3);
+
+#
+# Main loop; leave this untouched, put tests into the loop
+#
+use vars qw($state);
+while (Testing()) {
+ #
+ # Connect to the database
+ my $dbh = DBI->connect($test_dsn, $test_user, $test_password);
+# Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
+# or ServerError();
+
+ my @ids = connection_id($dbh);
+ print "Initial connection: @ids\n";
+
+ #read_write_test($dbh);
+
+ my $drh = $dbh->{Driver};
+
+ my $imp_data;
+ Test($state or $imp_data = $dbh->take_imp_data)
+ or ErrMsg("didn't get imp_data");
+
+ Test($state or length($imp_data) >= 80)
+ or ErrMsg('test that our imp_data is greater than or equal to 80, this is reasonable');
+
+ Test($state or $drh->{Kids} == 0)
+ or ErrMsg('our Driver should have 0 Kid(s) after calling take_imp_data');
+
+ {
+ my $warn;
+ local $SIG{__WARN__} = sub { ++$warn if $_[0] =~ /after take_imp_data/ };
+
+ my $drh = $dbh->{Driver};
+ Test($state or !defined $drh)
+ or ErrMsg('... our Driver should be undefined');
+
+ my $trace_level = $dbh->{TraceLevel};
+ Test($state or !defined $trace_level)
+ or ErrMsg('our TraceLevel should be undefined');
+
+ Test($state or !defined $dbh->disconnect)
+ or ErrMsg('disconnect should return undef');
+
+ Test($state or !defined $dbh->quote(42))
+ or ErrMsg('quote should return undefined');
+
+ Test($state or $warn == 4)
+ or ErrMsg('we should have gotten 4 warnings');
+ }
+
+ # XXX: how can we test that the connection wasn't actually dropped?
+
+ #use Data::Dumper;
+ #print "GOT $imp_data\n";
+ warn "re-CONNECT\n";
+
+ my $dbh2 = DBI->connect($test_dsn, $test_user, $test_password, { dbi_imp_data => $imp_data });
+# my $dbh2 = DBI->connect($test_dsn, $test_user, $test_password);
+
+ # XXX: how can we test that the same connection is used?
+ my @ids2 = connection_id($dbh2);
+ print "Overridden connection: @ids2\n";
+
+ Test($state or @ids2 == @ids)
+ or ErrMsg("the same number of connection: @ids => @ids2\n");
+
+ Test($state or $ids[0] == $ids2[0])
+ or ErrMsg("the same connection: @ids => @ids2\n");
+
+ my $drh2;
+ Test($state or $drh2 = $dbh2->{Driver})
+ or ErrMsg("can't get the driver\n");
+
+ Test($state or $dbh2->isa("DBI::db"))
+ or ErrMsg('isa test');
+ # need a way to test dbi_imp_data has been used
+
+ Test($state or $drh2->{Kids} == 1)
+ or ErrMsg("our Driver should have 1 Kid(s) again: having " . $drh2->{Kids} . "\n");
+
+ read_write_test($dbh2);
+
+ #
+ # Finally disconnect.
+ #
+ Test($state or $dbh2->disconnect())
+ or DbiError($dbh2->err, $dbh2->errstr);
+
+}
+
+sub read_write_test {
+ my $dbh = shift;
+
+ # now the actual test:
+
+ # Find a possible new table name
+ #
+ my $table;
+ Test($state or $table = FindNewTable($dbh))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # Create a new table
+ #
+ my $def;
+ if (!$state) {
+ ($def = TableDefinition($table,
+ ["id", "INTEGER", 4, 0],
+ ["name", "CHAR", 64, 0]));
+ print "Creating table:\n$def\n";
+ }
+ Test($state or $dbh->do($def))
+ or DbiError($dbh->err, $dbh->errstr);
+
+ #
+ # ... and drop it.
+ #
+ Test($state or $dbh->do("DROP TABLE $table"))
+ or DbiError($dbh->err, $dbh->errstr);
+
+}
+
+# XXX: this is a non-portable hack used for testing. want to find a
+# method that will allow us to get the connection ID and then later on
+# verify that the same ID is used.
+sub connection_id {
+ my $dbh = shift;
+
+ my $hash_ref = $dbh->selectall_hashref("SHOW FULL PROCESSLIST", [qw(User Id)]);
+
+ my @ids = keys % { $hash_ref->{stas} };
+
+ return sort @ids;
+}
-- __________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
