| Subject: | Enhancement: Provide a post-exec callback for statements / provide automatically locked hashrefs |
Hello Tim (and all),
this ticket is an enhancement wish for DBI.
The proposal is to have the option of returning locked hashrefs (Hash::Util::lock_ref_keys) from ->fetchall_arrayref({}) and ->selectall_arrayref(..., {Slice => {}}) .
The feature already exists as the attached module DBIx::LockedResults, but the module is icky for one reason:
The module employs the Callbacks feature of DBI to work its magic, but the callbacks don't have a way to run the original code and get at the results of the original code. So the callbacks get disabled, the original code is recursively called, and then the results are munged.
A better way would be to have a callback that runs after a statement method like ->fetchall_arrayref has finished and that can post-process the results of the statement method.
The best way would be to have the LockKeys => 1 option available to ->fetchall_arrayref and ->selectall_arrayref directly, because then I wouldn't have to write any code at all.
-max
| Subject: | 01-lock.t |
#!perl -w
use strict;
use Test::More;
use DBIx::LockedResults;
my $dbh= eval {
DBIx::LockedResults->connect(
'dbi:SQLite:dbname=:memory:',
undef,
undef,
{ RaiseError => 1, PrintError => 0 },
);
};
if(! $dbh ) {
plan skip_all => "SQLite not available? $@";
exit;
};
plan tests => 9;
$dbh->do(<<SQL);
create table myTable ( myText varchar(32), myId integer not null );
SQL
$dbh->do(<<SQL);
insert into myTable (myText,myid) values ('use Perl;',1);
SQL
$dbh->do(<<SQL);
insert into myTable (myText,myid) values ('Foo',2);
SQL
$dbh->do(<<SQL);
insert into myTable (myText,myid) values ('Bar',3);
SQL
my $res= $dbh->selectall_arrayref(<<SQL, { Slice => {}}, '%Perl%');
select myId, myText
from mytable
where mytext like ?
SQL
is 0+@$res, 1, 'We get the expected number of rows';
is ref $res->[0], 'HASH', 'We asked for a hash, we get a hash';
is ref $res->[0], 'HASH', 'We asked for a hash, we get a hash';
my $val;
my $lives= eval {
$val= $res->[0]->{myText};
1
};
is $val, 'use Perl;';
undef $val;
ok $lives, "We can access 'myText'"
or diag $@;
$lives= eval {
$val= $res->[0]->{yourtext};
diag "Live?!";
1
};
is $val, undef;
ok !$lives, "We can't access 'yourtext'";
undef $val;
$lives= eval {
$val= $res->[0]->{mytext};
1
};
is $val, undef;
ok !$lives, "We can't access 'mytext'";
| Subject: | LockedResults.pm |
package DBIx::LockedResults;
use strict;
use DBI;
use Hash::Util 'lock_keys';
sub connect {
my( $class, $dsn, $user, $pass, $options )= @_;
$options ||= {};
$options->{ Callbacks }= {
selectall_arrayref => \&selectall_arrayref,
ChildCallbacks => {
fetchall_arrayref => \&fetchall_arrayref,
},
};
DBI->connect( $dsn, $user, $pass, $options );
}
sub protect_hashrefs {
warn "Locking in effect";
lock_keys( %$_ )
for @{ $_[0] };
}
sub fetchall_arrayref {
my($sth, $options, @placeholders )= @_;
my $name= $_;
local $sth->{Callbacks}->{$name}; # prevent recursion
my $res= $sth->fetchall_arrayref( $options, @placeholders );
if( $options and $options->{Slice} and 'HASH' eq ref $options->{Slice}) {
protect_hashrefs( $res );
};
$res
}
sub selectall_arrayref {
my($dbh, $sql, $options, @placeholders )= @_;
my $name= $_;
local $dbh->{Callbacks}->{$name}; # prevent recursion
my $res= $dbh->selectall_arrayref( $sql, $options, @placeholders );
if( $options and $options->{Slice} and 'HASH' eq ref $options->{Slice}) {
protect_hashrefs( $res );
};
$res
}
1;