So you’ve got some perl code that connects to a particular database via a particular DBI driver. You want it to connect to a different database or driver. But you can’t change that part of the code. What can you do?
I ran into this problem recently. A large application is using an old version of DBIx::HA which doesn’t support DBD::Gofer. DBIx::HA can’t be upgraded (long story, don’t ask) but I wanted to use DBD::Gofer to provide client-side caching via Cache::FastMmap. (I’ll save more details of that, and the 40% reduction in database requests it gave, for another post.)
I needed a way for DBIx::HA to think that it was connecting to a particular driver and database, but for it to actually connect to another. Using $ENV{DBI_AUTOPROXY}
wasn’t an option because that has global effect whereas I needed fine control over which connections were affected. It’s also fairly blunt instrument in other ways.
It seemed like I was stuck. Then I remembered the DBI callback mechanism – it would provide an elegant solution to this. I added it to DBI 1.49 back in November 2005 and enhanced it further in 1.55. I’d never documented it though. I think I was never quite sure it had sufficient functionality to be really useful. Now I’m sure it has.
The DBI callback mechanism lets you intercept, and optionally replace, any method call on a DBI handle. At the extreme, it lets you become a puppet master, deceiving the application in any way you want.
Here’s how the code looked (with a few irrelevant details changed):
# The following section of code uses the DBI Callback mechanism to # intercept connect() calls to DBD::Sybase and, where appropriate, # reroute them to DBD::Gofer. our $in_callback; # get Gofer $drh and make it pretend to be named Sybase # to keep DBIx::HA 0.62 happy my $gofer_drh = DBI->install_driver("Gofer"); $gofer_drh->{Name} = "Sybase"; # get the Sybase drh and install a callback to intercept connect()s my $sybase_drh = DBI->install_driver("Sybase"); $sybase_drh->{Callbacks} = { connect => sub { # protect against recursion when gofer itself makes a connection return if $in_callback; local $in_callback = 1; my $drh = shift; my ($dsn, $u, $p, $attr) = @_; warn "connect via callback $drh $dsn\n" if $DEBUG; # we're only interested in connections to particular databases return unless $dsn =~ /some pattern/; # rewrite the DSN to connect to the same DSN via Gofer # using the null transport so we can use Gofer caching $dsn = "transport=null;dsn=dbi:Sybase(ReadOnly=1):$dsn"; my $dbh = $gofer_drh->connect($dsn, $u, $p, $attr); if (not $dbh) { # gofer connection failed for some reason warn "connect via gofer failed: $DBI::errstr\n" unless our $connect_via_gofer_err++; # warn once return; # DBI will now call original connect method } undef $_; # tell DBI not to call original connect method return $dbh; # tell DBI to return this $dbh instead }, };
So the application, via DBIx::HA, executed
$dbh = DBI->connect("dbi:Sybase:foo",...)
but what it got back was a DBD::Gofer dbh, as if the application has executed
$dbh = DBI->connect("dbi:Gofer:transport=null;dsn=dbi:Sybase(ReadOnly=1):foo",...)
.
I guess I should document the callback mechanism now. Meanwhile the closest thing to documentation is the test file.
I’ve always enjoyed this kind of “plumbing”. If you come up with any interesting uses of DBI callbacks, do let me know.
I can think of one immediately – SQL rewriting. As an example, create a callback on a DBD::Sybase handle for prepare such that if the server type is ASE, leave the sql code alone BUT if the server type is IQ, replace all db..table reference with db.table. The alternative is recoding when moving to an IQ server or building the query with in if/else statement.
Can you put callback on connect and disconnect? I’m sure that could be useful for something.
A callback can be set for any *driver* method.
A callback can be set for any *driver* method.
NOTE: An extra callback for connect_cached, with the recursion-protection mechanism, is needed. Otherwise a connect from within connect_cached will cause problems.
Here’s the code (the formatting may not survive):
connect_cached => sub {
# protect against recursion when gofer itself makes a connection
return if $in_callback; local $in_callback = 1;
my $dbh = shift->$_(@_);
undef $_; # tell DBI not to call original method
return $dbh; # tell DBI to return this instead
},