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"
