Tail Wags Baby Moose

Still Accessor.pm day here in the Moose::Pen.

In yesterday's post I was playing about with the 'raw_query' sub in Driver::DBI and that lead me back into Accessor.pm to make a few changes there. You might remember I had this as a final result in Accessor.pm

    sub raw_query {
       my $self = shift;
       my ($conn, $type, $container) = @_;
          unless (exists( Database::Accessor::Constants::OPERATORS->{ uc($type) } ));
       my $dad = $self->_get_dad($conn);
       my $raw = $dad->raw_query(uc($type));
       my $hash = {DAD=>ref($dad),
       return $hash;

and I even had a little test for in in 20_dad_load.t. Today I was trying to fix the problem adding in a sanity check so I will not have an empty $container passed into the 'raw_query' sub. While I was at it, I figured, I will add in a little check to ensure that the $conn was at least a class of some form.

Fortunately before I got too far along on this I realized that having a 'raw_query' sub in Accessor.pm was at best clunky and at worst an anti-pattern.

If I carried on in this way I would leave my end users with no easy way to debug their applications. They would have to write a separate call to actually 'see' what the end query is. Something like this;

my $user = Test::DB::User->new();
my $container = {username=>'user_new',
address =>'address_new'};
my $sql = $user->raw_query($utils->connect(),'create',$container);

Yuck! to say the least.

So putting my thinking Moose on I know I have a common API for all my CRUD sub so I will drop the 'raw_query' from Database::Accessor and add in an options hash key that will trigger this on the command, like this


The key 'raw_query' is just an example as I have to be careful here as I will be passing these option down to the underlying Database class and I do not want them to conflict with any of them. Thus, I will use this style of key 'DA_' when creating them.

Now the next part is doing the sanity check and what I first though I needed was a new sub but I will only make this check now in one place in the '_execute' sub. As well the '_get_dad' sub is no longer needed as it is called in only one place. So I added the code for both in the '_execute', a little ugly but at least all the checks are in one place.

This is what I came up with in the end;

private_method _execute => sub {
my $self = shift;
my ( $action, $conn, $container, $opt ) = @_;
die "Usage: Database::Accessor->"
. lc($action)
. "(\$connection,\$container,\$options); "
. "You must supply a \$connection, and \$container "
if ( !blessed($conn) or $container == undef );

my $drivers = $self->_ldad();
my $driver = $drivers->{ ref($conn) };
die "No Database::Accessor::Driver loaded for "
. ref($conn)
. " Maybe you have to install a Database::Accessor::Driver::?? for it?"
unless ($driver);
if ( $action eq Database::Accessor::Constants::CREATE ) {
my $message =
"Usage: Database::Accessor->"
. lc($action)
. "( Class , Hash-Ref||Class||Array-Ref of [Hash-ref||Class], Hash-Ref); "
. "The \$container parameter must be either a Hash-Ref, a Class or an Array-ref of Hash-refs and or Classes";
if ( ref($container) eq "ARRAY" ) {
my @bad =
grep( !( ref($_) eq 'HASH' or blessed($_) ), @{$container} );
die $message
. " The 'Array-Ref' is must contain only Hash-refs or Classes";
die $message
if ( ref($container) ne 'HASH' or !blessed($container) );
elsif ($action eq Database::Accessor::Constants::RETRIEVE
or $action eq Database::Accessor::Constants::UPDATE )
die "Usage: Database::Accessor->"
. lc($action)
. "( Class , Hash-Ref||Class, Hash-Ref); "
. "The \$container parameter must be either a Hash-Ref or a Class"
if ( ref($container) ne 'HASH' or !blessed($container) );

my $dad = $driver->new(
view => $self->view,
elements => $self->elements,
dynamic_elements => $self->dynamic_elements,
conditions => $self->conditions,
dynamic_conditions => $self->dynamic_conditions,
links => $self->links,
dynamic_links => $self->dynamic_links,
gathers => $self->gathers,
dynamic_gathers => $self->dynamic_gathers,
filters => $self->filters,
dynamic_filters => $self->dynamic_filters,
sorts => $self->sorts,
dynamic_sorts => $self->dynamic_sorts,
my $result = $dad->execute( $action, $conn, $container, $opt );

Now when I re-ran my test suite I got

Result: FAIL
Failed 16/26 test programs. 5/142 subtests failed.

Opps I expected a few fails in '20_dad_load.t' but not 16 out of 26 of my cases so I think I still have few things to work out before I get back to Driver::DBI.

Anyway you can take a sure bet on what the subject of tomorrow's post is going to be.


Leave a comment

About byterock

user-pic Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations