byterock

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) = @_;

       

       $self->_try_one_of(Database::Accessor::Constants::OPERATORS)

          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),

               query=>$raw};

       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'};

#$user->create($utils->connect(),$container); 

my $sql = $user->raw_query($utils->connect(),'create',$container); 

warn($sql);

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

$user->create($utils->connect(),$container,{raw_query=>1});

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.