On Feb 14, 2005, at 3:14 AM, Tim Bunce wrote:
In relation to connect_cached it boiled down to just the difference between:
if ($dbh and my $oc = $dbh->{OnConnect}) { $oc->($dbh, $dsn, $user, $pass, $attr) if ref $oc eq 'CODE'; }
and:
if (my $cb = $dbh->{Callbacks}) { my $oc = $cb->{"connect_cached.reused"}; $oc->($dbh, $dsn, $user, $pass, $attr) if ref $oc eq 'CODE'; }
Not much in it really! :)
Oh, I see. So then Callbacks just becomes a hash reference of code references, with each corresponding to a particular event. That is cleaner. And easily done in Perl.
The rest of the $h->{Callbacks} infrastructure needn't be implemented
for just that bit. All it needs is for Callbacks to become a valid
DBI attribute.
Which is also pretty easily done, eh? Something like this? Please forgive my newbie XS coding. And yes, I know this doesn't compile. I couldn't figure out where to declare Callbacks.
Index: DBI.xs
===================================================================
--- DBI.xs (revision 856)
+++ DBI.xs (working copy)
@@ -1500,6 +1500,23 @@
else if (strEQ(key, "TaintOut")) {
DBIc_set(imp_xxh,DBIcf_TaintOut, on);
}
+ else if (strEQ(key, "Callbacks")) {
+ if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVHV)) ) {
+ croak("Can't set Callbacks to '%s'",neatsvpv(valuesv,0));
+ }
+ char *key;
+ I32 klen;
+ SV *val;
+ HV *hv = (HV*)GvHV(valuesv);
+ (void)hv_iterinit(hv);
+ while ((val = hv_iternextsv(hv, (char **) &key, &klen))) {
+ if ( on && (!SvROK(val) || (SvTYPE(SvRV(val)) != SVt_PVCV)) ) {
+ croak("Can't set '%s' callback to '%s'", key, neatsvpv(val,0));
+ }
+
+ }
+ DBIc_set(imp_xxh,DBIcf_Callbacks, on);
+ }
else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "CachedKids")) {
D_imp_dbh(h); /* XXX also for drh */
if (DBIc_CACHED_KIDS(imp_dbh)) {
Index: DBI.pm
===================================================================
--- DBI.pm (revision 856)
+++ DBI.pm (working copy)
@@ -650,10 +650,9 @@
# if we've been subclassed then let the subclass know that we're connected
$dbh->connected($dsn, $user, $pass, $attr) if ref $dbh ne 'DBI::db';
- # if the caller has provided a callback then call it
- # especially useful with connect_cached() XXX not enabled/tested/documented
- if (0 and $dbh and my $oc = $dbh->{OnConnect}) { # XXX
- $oc->($dbh, $dsn, $user, $pass, $attr) if ref $oc eq 'CODE';
+ # If the caller has provided a callback then call it
+ if ($dbh and my $cb = $dbh->{Callbacks}{connect}) {
+ $cb->($dbh, $dsn, $user, $pass, $attr);
}
DBI->trace_msg(" <- connect= $dbh\n") if $DBI::dbi_debug;
@@ -1409,9 +1408,10 @@
};
my $dbh = $cache->{$key};
if ($dbh && $dbh->FETCH('Active') && eval { $dbh->ping }) {
- # XXX warn if BegunWork?
- # XXX warn if $dbh->FETCH('AutoCommit') != $attr->{AutoCommit} ?
- # but that's just one (bad) case of a more general issue.
+ # If the caller has provided a callback then call it
+ if (my $cb = $dbh->{Callbacks}{"connect_cached.reused"}) {
+ $cb->($dbh, $dsn, $user, $auth, $attr);
+ }
return $dbh;
}
$dbh = $drh->connect(@_);
Regards,
David
