Skip Menu |
 

This queue is for tickets about the DBI CPAN distribution.

Report information
The Basics
Id: 99705
Status: new
Priority: 0/
Queue: DBI

People
Owner: Nobody in particular
Requestors: corion [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: Enhancement: Provide a post-exec callback for statements / provide automatically locked hashrefs
Download (untitled) / with headers
text/plain 987b
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
Download 01-lock.t
text/x-perl 1.4k
#!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
Download LockedResults.pm
text/x-perl 1.2k
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;


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.