Enhancement: Provide a post-exec callback for statements / provide automatically locked hashrefs

[rwfranks]

Transcribed verbatim from CPAN RT#99705, warts and all.

Tue Oct 21 15:18:38 2014 corion [...] cpan.org - Ticket created
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
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
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;