Moose Forges Ahead

Its take one step forward day here in the Moose Pen

today I am going to try and fix that stoppage I had yesterday. To recap I have a rule in my API that states that I can only 'update' or 'create' on elements that have the same view as the DA. So given this DA hash

{ view => { name => 'people' },
elements => [
{ name => 'first_name',},
{ name => 'last_name',},
{ name => 'id', },
{ name => 'street',
view => 'address'},
links => { type => 'LEFT',
to => { name => 'address' },
conditions => [{
left => { name => 'id' },
right => {
name => 'user_id',
view => 'address'

and this update container hash;

$container = {first_name=>'Bob',
street =>'1313 Mocking bird lane',
phone =>'555mrplow'};

I should not be able to 'update' or 'insert' on the 'street' element as it does not share the same view and the 'phone' element as it is not even in the DA. Therefore I have to test to ensure both have been dropped from the container before it gets to the DA.

Yesterday I did change my ''40_joins.t' test case to catch this bug which is fine by this is a Database::Accessor level rule so I want to add a test and the code change in there.

The test case I selected to play with was '50_create.t' and the first thing I did was add in;

name => 'street',
view => 'Address'

to the elements hash and added in the following test later on;

$da->create( $data, $container );
my $dad = $da->result->error();

and at this point I was a little stuck as I never have a need to check the value of the '$container' before. So I had no way to see it after it is was down into the DA. I will have to add that in first;

Checking on what I do in the Database::Accessor::Driver::Test;

sub execute {
my $self = shift;
my ($result, $type, $conn, $container, $opt ) = @_;
$result->query($type.' Query');
$result->error($self); #kludge for testing. Sends the DAD back to ensure it is correct
return $result;

I am adding info to the 'Result' class and I think I will leverage the unused 'params' attribute to return my container;

sub execute {
my $self = shift;
my ($result, $type, $conn, $container, $opt ) = @_;
++ $result->add_param($container);

and in my test check it like this;

--my $dad = $da->result->error();
++my $in_container = $da->result->params->[0];
"Container drops street"

and now that fails;

not ok 8 - Container drops street

Now to add in the fix someplace;

After a little trial an error this is the patch I came up with. First a new function to clean up the container;

sub _clean_up_container {
my $self = shift;
my ($message,$container) = @_;
my @new_container = ();
foreach my $row (@{$container}){
my $new_row = {};
foreach my $key (keys(%{$row})){
my $field = $self->get_element_by_name($key);
if ( !$field );
if ( ($field->view) and ($field->view ne $self->view()->name()));
$new_row->{$key} = $row->{$key};
die $message .= "The \$container must have at least 1 element with the view="
if ( !scalar( @new_container ) );
return \@new_container;

nothing much here I just loop over the keys and only select those that either have no 'view' (defaults to DA's view) or if they have a view it matches with the DA's view. At the the end I have added in another die if there is nothing in the container.

Along with the above I also updated the '_create_or_update' sub a little;

sub _create_or_update {
my $self = shift;
my ( $action, $conn, $container, $opt ) = @_;
++ my $new_container;
my $message =
"Usage: Database::Accessor->"
. lc($action)
. "( Class , Hash-Ref||Class||Array-Ref of [Hash-ref||Class], Hash-Ref); ";

if ( ref($container) eq "ARRAY" ) {

die $message .= "The \$container Arry-Ref cannot be empty"
if ( !scalar( @{$container} ) );

my @bad =
grep( !( ref($_) eq 'HASH' or blessed($_) ), @{$container} );
die $message
. " The \$container 'Array-Ref' must contain only Hash-refs or Classes"
if ( scalar(@bad) );
++ $new_container = $self->_clean_up_container($message,$container);
else {
die $message .=
"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 'HASH' or blessed($container) ) );
die $message .= "The \$container Hash-Ref cannot be empty"
if ( ref($container) eq 'HASH' and !keys( %{$container} ) );
++ $new_container = shift(@{$self->_clean_up_container($message,[$container])});

I do a little bit of a trick when the container is not an Array-Ref by sending it down to the funtion wrapped in []. Now when I run my test I get;

ok 1 - No Create with out connection class
ok 2 - No Create with empty hash-ref container
Usage: Database::Accessor->create( Class , Hash-Ref||Class||Array-Ref of [Hash-ref||Class], Hash-Ref); The $container must have at least 1 element with the view=People! at

# Looks like your test exited with 255 just after 2.

Opps forgot to update my test case;


and on the next run I get;

ok 3 - Container can be a non empty Hash-ref

but the same error on the next test. To fix that one I had to convert the 'Data::Test' class over to a Moose class with default attributes that matched up with the test container;

package Data::Test;
use Moose;
has [
] => (
is => 'rw',
isa => 'Str',
default => 'test'

and now all my tests pass;

Now just add in one more test

$container = {first_name=>'Bob',
street =>'1313 Mocking bird lane',
phone =>'555mrplow'};

$da->create( $data, $container );;
$in_container = $da->result->params->[0];
"Container drops street and phone"

to see if that phone stays out and that passes as well;

ok 8 - Container drops street
ok 9 - Container drops street and phone

Done for today;


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