Re: Callbacks registered on class, not instance?

Jenda Krynicky schrieb am 11.07.2012 um 12:23 (+0200):

> > http://search.cpan.org/~timb/DBI-1.622/DBI.pm#Callbacks

> > in theory, we could load the DBI module in the loader script so the
> > DBI code would be there, and then we could register callbacks on the
> > *class*, not on the *instance*, and they would be called *from* the
> > instance. In other words, global callbacks.

> Hack it. Something like
> 
> use DBI;
> 
> {
>   my $old_connect = \&DBI::connect;
>   *DBI::connect = sub {
>     my $connection = $old_connect->(@_) or return;
>     do anything you like with the connection
>     return $connection;
>   }
> }

Thank you, that works perfectly, see sample script below.

-- Michael

use strict;
use warnings;
use DBI;
use constant DBI_REG_CB => 1;

sub run_test {
	my( $dsn, $user, $pass, $qry ) = @_;
	my $dbh = DBI->connect($dsn, $user, $pass, {RaiseError => 1, PrintError => 0});
	my $table = $dbh->selectall_arrayref($qry);
	print join("\t", @$_), "\n" for @$table;
	return;
}

if (DBI_REG_CB) {
	my $old_connect = \&DBI::connect;
	my $new_connect = sub {
		my $dbh = $old_connect->(@_) or return;
		$dbh->{Callbacks} = {
			prepare => sub {
				my( $dbh, $qry, $attrs ) = @_;
				print STDERR "preparing: $qry\n";
				return;
			},
		};
		return $dbh;
	};
	no warnings 'redefine';
	*DBI::connect = $new_connect;
}

run_test @ARGV; # dbi:Firebird:eins michael secret "select * from zzz"