Subject: | After-connected callback Patch |
After-connected callback Patch
User-Agent: Mutt/1.4.2.2i
[-- Вложение #1 --]
[-- Тип: text/plain, кодировка: 7bit, размер: 0.8K --]
Hello.
I've added new callback to DBI: "connect.after_connected".
This Callback is called just after establishing connection
to the database.
This callback is useful, for example, for performing
database set up queries.
For example to send "SET NAMES ..." query to MySQL
to set up connection character set.
Usage example:
my $self = DBI->connect_cached(
"DBI:mysql:$dbname", $username, $password,
{
Callbacks => {
"connect.after_connected" => sub {
my ($dbh) = @_;
$dbh->do( 'SET NAMES CP1251' );
}
}
}
);
* * *
Also I've attached patch for tracing connect_cached keys
when dbi_debug is set.
It is useful for determining why particular connection
was not get from cache, etc.
* * *
Both patches are for the latest SVN version of DBI.
Subject: | DBI-after-connected-callback.patch |
Index: DBI.pm
===================================================================
--- DBI.pm (revision 9622)
+++ DBI.pm (working copy)
@@ -650,6 +650,13 @@
return $dbh; # normally undef, but HandleError could change it
}
+ # Call after-connected callback
+ my $cb = $attr->{Callbacks}; # take care not to autovivify
+ if ($cb and $cb = $cb->{"connect.after_connected"}) {
+ local $_ = "connect.after_connected";
+ $cb->($dbh, $dsn, $user, '****', $attr);
+ }
+
# merge any attribute overrides but don't change $attr itself (for closure)
my $apply = { ($override_attr) ? (%$attr, %$override_attr ) : %$attr };
Subject: | DBI-connect_cached-key-trace-msg.patch |
Index: DBI.pm
===================================================================
--- DBI.pm (revision 9622)
+++ DBI.pm (working copy)
my $key = do { local $^W; # silence undef warnings
join "~~", $dsn, $user||'', $auth||'', $attr ? (@attr_keys,@{$attr}{@attr_keys}) : ()
};
+
+ if ($DBI::dbi_debug >= 2) {
+ DBI->trace_msg("connect_cached key: \"".$key."\"\n");
+ }
+
my $dbh = $cache->{$key};
my $cb = $attr->{Callbacks}; # take care not to autovivify
if ($dbh && $dbh->FETCH('Active') && eval { $dbh->ping }) {