Even More Moose API
Its even more moose day here in the Moose-Pen
For those of you who might have been a little disappointed that there has not been much Moose in my posts of late today you are in for a treat.
Yesterday I had the problem where I may have a nice Database::Accessor all set up that returns all the people in a DB. Good and nice but now I wanted to group them by 'region' which I could do like this;
$address_da->only_elements({region=>1});
$da->add_gather({elements => [{name => 'description',
view => 'region'}]});
but there is no way I can get a count of users as I had no way to add this aggregate function
{
function => 'count',
left => { name => 'user_id',
view => 'People6'
}
}
to my elements attribute on the Database::Accessor. Not good for the long run usefulness of my app.
I put my thinking Moose on and I came up with a very workable solution. I will add into my Gather class the ability to list the 'elements' I want to return. Like all good test based developers I wrote the test firs (well really just modified the $in_hash) in the '37_gathers.t' case;
gather => {
elements => [
{
name => 'first_name',
view => 'People4'
},
{
name => 'last_name',
view => 'People5'
},
{
name => 'user_id',
view => 'People6'
}
],
++ view_elements => [
++ {
++ name => 'first_name',
++ view => 'People4'
++ },
++ {
++ name => 'last_name',
++ view => 'People5'
++ },
++ {
++ function => 'count',
++ left => { name => 'user_id',
++ view => 'People6'
++ }
++ }
++ ],
Now to implement this in Accessor.pm.
First I need to add that 'view_elements' attribute to the 'Gather' class'
has view_elements => (
isa => 'ArrayRefofGroupElements',
is => 'rw',
traits => ['Array'],
handles => { view_count => 'count',
},
);
Nothing special but I did create a new type 'ArrayRefofGroupElements' which I will now have to define a new subtype in the 'Database::Accessor::Types' class;
subtype 'ArrayRefofGroupElements' => as
'ArrayRef[Element|Function]',
where { scalar(@{$_})<=0 ? 0 : 1; },
message {
"ArrayRefofGroupElements can not be an empty array ref";
};
Note that in this 'as' has only 'Element|Function' in the ArrayRef 'as' and that is reason for this is I want to limit what can be put into the view_elements.
Now that I have the 'subtype' I have to write a 'coerce' for it and here it is;
coerce 'ArrayRefofGroupElements', from 'ArrayRef', via {
my ($in) = $_;
my $objects = [];
foreach my $object ( @{$in} ) {
if ( ref($object) eq "ARRAY" ) {
push( @{$objects}, @{$object} );
}
else {
if ( exists( $object->{function} ) ) {
die "Attribute (view_elements) does not pass the type constraint because:
Validation failed for 'ArrayRefofGroupElements'.
The Aggrerate '$object->{function}', is not a valid Accessor Aggregate! "
._try_one_of( Database::Accessor::Constants::AGGREGATES())
unless (exists( Database::Accessor::Constants::AGGREGATES->{ uc($object->{function}) } ));
$object->{function} = uc($object->{function});
$object = Database::Accessor::Function->new( %{$object} );
}
else {
$object = Database::Accessor::Element->new( %{$object} );
}
push( @{$objects}, $object );
}
}
return $objects;
};
In the above I loop though what is coming into the 'coerce' if I get an 'Array' then I have already processed the element, otherwise I check to see if the $object is a function and if it is I check the value of it against my AGGREGATES() constant and if it passes I create a new Function class with it. If the $object is not a function I just create a new Element class with it. Next I add that $object to the $objects array and return that once I am down.
So now that all of that is in there I run my test and I got a full pass so the above works.
Looking at my test I did notice I am now not testing to see it those “view_elements” get passed down to the DAD so I add this test in;
++Test::Database::Accessor::Utils::deep_element( $in_hash->{gather}->{elements},
++ $da->gather->elements, $dad->gather->elements, 'Gather' );
Test::Database::Accessor::Utils::deep_element( $in_hash->{gather}->{view_elements},
$da->gather->view_elements, $dad->gather->view_elements, 'Gather' );
and when I run it I get a hard fail
Can't call method "view" on an undefined value at C:/Dwimperl/perl/site/lib/Test/Deep/Methods.pm line 65.
Still some coding to do. This patch fixes will fix that me thinks;
if ($action eq Database::Accessor::Constants::RETRIEVE and ($self->gather() || $self->dynamic_gather()) ){
my @elements;
my @conditions;
++ my @view_elements;
if ($self->gather()) {
push(@elements,@{$self->gather()->elements()});
push(@conditions,@{$self->gather()->conditions});
++ push(@view_elements,@{$self->gather()->view_elements});
}
if ($self->dynamic_gather()){
push(@elements, @{$self->dynamic_gather()->elements()});
push(@conditions,@{$self->dynamic_gather()->conditions});
++ push(@view_elements,@{$self->dynamic_gather()->view_elements});
}
$gather = Database::Accessor::Gather->new({elements=>\@elements,
++ view_elements=>\@view_elements,
conditions=>\@conditions});
}
However when I run my test I get;
...
ok 13 - DAD Gather 1 correct
--not ok 14 - DA Gather 2 correct
--not ok 15 - DAD Gather 2 correct
ok 16 - No Gathers on create
...
Hmm Dumping the $dad I see the view_elements present;
'gather' => bless( {
'view_elements' => [
bless( {
…
I suspect my test function cannot handle that new element.
Poking about I found two issues. First good old perl pass by reference converts that '$in_hash->{gather}->{elements}' into objects so I have to do a 'receive' before the second test;
Test::Database::Accessor::Utils::deep_element( $in_hash->{gather}->{elements},
$da->gather->elements, $dad->gather->elements, 'Gather' );
++$da->retrieve( Data::Test->new(), $return );
++my $dad = $da->result->error();
Test::Database::Accessor::Utils::deep_element( $in_hash->{gather}->{view_elements},
$da->gather->view_elements, $dad->gather->view_elements, 'Gather' );
and in the 'deep_element' function I had to adjust it so it can handle a 'Function' class;
foreach my $index ( 0 .. scalar( @{$in} - 1 ) ) {
-- bless( $in->[$index], "Database::Accessor::Element" );
++ if (exists($in->[$index]->{function})){
++ bless( $in->[$index], "Database::Accessor::Function" );
++ }
++ else {
++ bless( $in->[$index], "Database::Accessor::Element" );
++ }
and now I get a full pass;
...
ok 13 - DAD Gather 1 correct
ok 14 - DA Gather 2 correct
ok 15 - DAD Gather 2 correct
ok 16 - No Gathers on create
…
I still have one more little adjustment, I will have to adjust what is going to the 'elements' attribute of the DAD as that should now only be the 'view_elements' from the gather; Fist another test;
$da->retrieve( Data::Test->new(), $return );
my $dad = $da->result->error();
Test::Database::Accessor::Utils::deep_element( $in_hash->{gather}->{view_elements},
$da->gather->view_elements, $dad->elements, 'Elements' );
and now some code changes. First in the 'get_dad_elements' sub
++ my @elements = @{$self->elements()};
++ @elements = @{$self->gather->view_elements()}
++ if ($self->gather->view_count());
-- for (my $index=0; $index < scalar(@{$self->elements()};); $index++) {
++ for (my $index=0; $index < scalar(@elements); $index++) {
++ my $element = $self->elements()->[$index];
++ $element = $self->gather->view_elements()->[$index]
++ if ($self->gather->view_count());
plus one that I just noticed;
-- push(@items,(@{ $self->gather->conditions }, @{ $self->gather->elements }))
++ push(@items,(@{ $self->gather->conditions }, @{ $self->gather->elements },
@{ $self->gather->view_elements }))
if ( $self->gather());
and now I get;
ok 1 - use Database::Accessor::Gather;
ok 2 - gather is a Gather
ok 3 - 'Gather is a Database::Accessor::Base' isa 'Database::Accessor::Base'
ok 4 - DA Gather 0 correct
ok 5 - DAD Gather 0 correct
ok 6 - DA Gather 1 correct
ok 7 - DAD Gather 1 correct
ok 8 - DA Gather 2 correct
ok 9 - DAD Gather 2 correct
ok 10 - DA Gather View 0 correct
ok 11 - DAD Gather View 0 correct
ok 12 - DA Gather View 1 correct
ok 13 - DAD Gather View 1 correct
ok 14 - DA Gather View 2 correct
ok 15 - DAD Gather View 2 correct
ok 16 - DA Elements 0 correct
ok 17 - DAD Elements 0 correct
ok 18 - DA Elements 1 correct
ok 19 - DAD Elements 1 correct
ok 20 - DA Elements 2 correct
ok 21 - DAD Elements 2 correct
ok 22 - No Gathers on create
ok 23 - No Gathers on update
ok 24 - No Gathers on delete
so looking good.
Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations
Leave a comment