A little More API Moose

Its piddle with old code day here in the Moose-Pen

Yesterday I managed to clean up the '$container' param and now it only sends down to the DAD only items that match with the present view. After cleaning up all the related tests and adding a few more test in other test cases I have a little time last night to try some piratical use of Database::Accessor.

The first thing I discovered was it is very frustrating to the end user to send a '$container' down to a DAD have something unexpected happen and not know why or at least be able to see what was acted on.

Therefor I am going to expand my API yet again and include the both the passed in '$container' and the processed '$container' param in the 'Database::Accessor::Result' class.

Easy enough to implement but there are a few little problems. Being a param '$container' is only in local 'sub' level memory as it is entered by this calling structure;

( Class , Hash-Ref||Class||Array-Ref of [Hash-ref||Class], Hash-Ref)

directly by the end user on the 'update' or 'create' commands which calls the '_create_or_update' ion both case with the same signature but then it calls the '_execute' again with the same signature but this time I have swapped the '$container' for the '$new_container'. Thus later in the latter sub when I instantiate the 'Result' I only have the '$new_container' class present. I will have to take that into account.

First I will need a test for this and the best place for this is in the '20_dad_load.t' test case;

Frist I have to clean up the test a little as I have this

my $da =
Database::Accessor->new( { retrieve_only => 1,
view => { name => 'test' },
elements=>[{ name => 'street',
view => 'person', }] } );

that 'view' should be 'person' not test so I can have at least one item in a container that matches up with the view. After a quick search and replace on that I re-ran my test to make sure I did not blotch anyting and I am ready to add my next test I simply modify this loop a little;

foreach my $type (qw(create retrieve update )){
my $container = {key=>1,
++ street=>'131 Madison Ave.' };
++ my $processed_container = {street=>'131 Madison Ave.' };
ok($da_new->$type(Data::Test->new(),$container) == 1,"$type Query ran");
if ($type eq 'create' or $type eq 'update') {
ok($da_new->result()->is_error == 0,"$type->No Error");
ok($da_new->result()->effected() == 10,"$type->10 rows effected");
ok($da_new->result()->query() eq uc($type).' Query','correct '.uc($type)." query returned");
ok($da_new->result()->DAD() eq 'Database::Accessor::Driver::Test',"$type->correct raw DAD class");
ok($da_new->result()->DB() eq 'Data::Test',"$type->correct DB");
ok(ref($da_new->result()->error) eq 'Database::Accessor::Driver::Test', "Got an object in the error class");
++ cmp_deeply(
++ $container,
++ $da_new->result()->in_container(),
++ "In Container stays the same!"
++ );
++ cmp_deeply(
++ $processed_container,
++ $da_new->result()->processed_container(),
++ "Processed Container drops key!"
++ );

This will fail fatally as I have not yet made any code changes so I better do those. First the new attributes in the 'Result' class ;

use Moose;

++ has [ qw(in_container
++ processed_container)
++ ] => (
++ isa => 'ArrayRef|HashRef|Undef',
++ is => 'rw'
++ );

has is_error => (

and then a little change to the calling signature of the '_execute' sub and the places where I call it;

private_method _execute => sub {
my $self = shift;
-- my ( $action, $conn,$new_container,$container, $opt ) = @_;
++ my ( $action, $conn,$new_container,$container, $opt ) = @_;

The '_insert_or_update' sub;

  $self->_all_elements_present( $message, $new_container )
          if ( $self->all_elements_present );
--      return $self->_execute( $action, $conn, $new_container, $opt );
++        return $self->_execute( $action, $conn, $new_container, $container, $opt );
and then the 'retrieve' and 'delete' sub;

        my $container = {};
        return $self->_execute( Database::Accessor::Constants::RETRIEVE,
--          $conn, $container,$opt );
++          $conn, $container, $container,$opt );
now back into the '_execute' sub and set the 'in_container' and attribute;

        my $result = Database::Accessor::Result->new(
 ++         { DAD => $driver, operation => $action, in_container=>$container } );
At this point I started thinking again as there might be a case where the target DAD may have to process the '$new_container' and change it somehow.

Before I go to far I will change things up on my API a little and state that the 'in_container' is now defined as the container passed to the DAD and the 'processed_container' is the container the DAD utilized. I think this will be best as end user already knows what she passed in on the $container so no need to duplicate that data. Now please close your eyes and ignore the signature changes to the '_execute' sub I did above as I roll them back.

Carrying on I now have to make this change in 'Database::Accessor::Driver::Test'

-- $result->add_param($container);
++ $container->{dad_fiddle} = 1;
++ $result->processed_container($container);

to bounce that $container back for checking that is changed. Now to change my test to account for this change. First in '50_create.t' and '54_update.t' a few changes like this

-- my $in_container = $da->result->params->[0];
++ my $in_container = $da->result->in_container->[0];

and in good old '20_dad_load.t';

my $container = {key=>1,
street=>'131 Madison Ave.' };
my $in_container = {street=>'131 Madison Ave.' };
my $processed_container = {street =>'131 Madison Ave.',
dad_fiddle => 1 };

{key=>1, street=>'131 Madison Ave.' },
"Container stays the same!"
"In Container stays the same!"
"Processed Container drops key!"

I also added in another test to make sure I am not mucking with the original container.

And here we go;

not ok 52 - In Container stays the same!
# Comparing hash keys of $data
# Missing: 'dad_fiddle'

not ok 63 - In Container stays the same!
# Comparing hash keys of $data
# Missing: 'dad_fiddle'

Opps! Let me check the code in my Test DAD.

I always forget that Perl passed params by reference and not values so what is done to a var in a sub stays with it. This little patch should fix that by creating a new hash-ref and copying over the key value pairs from the passed in $contianer.

-- $container->{dad_fiddle} = 1;
-- $result->processed_container($container);
++ my $processed_container = {dad_fiddle=>1};
++ foreach my $key (keys(%{$container})){
++ $processed_container->{$key} = $container->{$key};
++ }

and on my next run I get a full pass;

Now onto something else;


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