Moose Coerce Case
Still case day here in the Moose-Pen
Following on from yesterday's post I first want to make a little changes to my 'Case' class; I think it will be better to have this
--has 'case' => (
++has 'whens' => (
isa => 'ArrayRefofWhens',
is => 'ro',
required => 1,
);
and that jibes a little better with the type that I am using. I will of course have to change a few things first in my tests and after a few mins of typeing that was all cleared up. Now onto the types.
This should be old hat by now as I first have to add in the following to Database::Accessor::Types;
...
use Database::Accessor::Expression;
++use Database::Accessor::Case;
++use Database::Accessor::Case::When;
++class_type 'Case', { class => 'Database::Accessor::Case' };
++class_type 'When', { class => 'Database::Accessor::Case::When' };
class_type 'View', { class => 'Database::Accessor::View' };
and next the sub type for 'ArrayRefofWhens';
...
class_type 'Gather', { class => 'Database::Accessor::Gather' };
++subtype 'ArrayRefofWhens' => as 'ArrayRef[Whens]';
subtype 'ArrayRefofConditions' => as 'ArrayRef[Condition]';
…
Now the tricky part the coerce statement. I think the best bet for success is to do the same thing I did for 'ArrayRefofConditions' where I use another function and that will enable me to do recursions to account for the 'Whens' that may have more that one condition. . Here it the 'coerce' statement;
coerce 'ArrayRefofWhens', from 'ArrayRef', via {
return _when_array_or_object( $_ );
};
in this case I think I will only need the ArrayRef 'via' as there will always be at least two 'whens' in a case and I do not need to pass the class down as I will always be using a 'When' class.
Now I need that '_when_array_or_object' sub and this is my first crack at it;
sub _when_array_or_object {
my ($in ) = @_;
my $objects = [];
foreach my $object ( @{$in} ) {
if ( ref($object) eq 'Database::Accessor::Case::When' ) {
push( @{$objects}, $object );
}
elsif ( ref($object) eq "ARRAY" ) {
push(
@{$objects},
@{ _when_array_or_object( $object ) }
);
}
else {
push( @{$objects}, Database::Accessor::Case::When->new( { $object } ) );
}
}
return $objects;
}
All I do in the above is iterate over the $in array and first check if the in $object is set I add it to the return stack. If the in $object is an array I then recourse with the function on the $object. Finally if I skip the first two I then do a new 'When' class and add it to the return stack.
Back to my test case '15_case.t' and I give that a go;
Odd number of elements in anonymous hash at D:\GitHub\database-accessor\lib/Database/Accessor/Types.pm line 230.
Attribute (left) is required at D:\GitHub\database-accessor\lib/Database/Accessor/Types.pm line 230# Looks like your test exited with 255 just after 4.
Ok that is close. What is happening above is my 'left' is required and there is no 'left' on the last item in my when hash;
{
condition => 'and',
left => { name => 'Price' },
right => { value => '100' },
operator => '<=',
message => { value => '30~100$' }
},
],
{ message => { value => 'Over 100$' } },
]
To fix that I have to go back into the “Database::Accessor::Case::When” class and see if I can override that 'required' attribute and I will give this a try with the standard Moose override has '+';
package
Database::Accessor::Case::When;
use Moose;
extends 'Database::Accessor::Predicate';
++ has '+left' => ( required => 0 );
has 'message' => (
isa => 'Str',
is => 'rw',
);
and I run my tests again I get this result;
Attribute (message) does not pass the type constraint because: Validation failed for 'Str' with value { value: "under 10$" } at 15_case.t line 20# Looks like your test exited with 255 just after 2.
Looks like I forgot to change the 'type' of that 'message' attribute to a 'Param';
-- isa => 'Str',
++ isa => 'Param',
and on my next run I get;
Odd number of elements in anonymous hash at D:\GitHub\database-accessor\lib/Database/Accessor/Types.pm line 230.
...
Attribute (whens) does not pass the type constraint because: Validation failed for 'ArrayRefofWhens' with value [ Database::Accessor::Case::When{ close_parentheses: 0, condition: undef, open_parentheses: 0 }, Database::Accessor::Case::When{ close_parentheses: 0, condition: undef, open_parentheses: 0 }, Database::Accessor::Case::When{ close_parentheses: 0, condition: undef, open_parentheses: 0 },
…
I think I will fix that 'Odd number of elements' fail first and that is actually just a typo on my part where I left in the '{}' around a hash-ref;
– push( @{$objects}, Database::Accessor::Case::When->new( { $object } ) );
++ push( @{$objects}, Database::Accessor::Case::When->new( $object ) );
and on my next run I get;
Attribute (name) is required at
GitHub\database-accessor\lib/Database/Accessor/Types.pm line 178
Well that is easy enough to fix
extends 'Database::Accessor::Predicate';
has '+left' => ( required => 0 );
++ has '+name' => ( required => 0 );
and on this run I get the same. In the end I forgot to add the 'name' attribute to a few of the 'left' fields so here is the fixed one;
{ whens => [
{
left => { name => 'Price', },
right => { value => '10' },
operator => '<',
message => { value => 'under 10$' }
},
[
{
left => { name =>'Price'},
right => { value => '10' },
operator => '>=',
},
{
condition => 'and',
-- left => 'Price',
++ left => { name => 'Price' },
right => { value => '30' },
operator => '<=',
message => { value => '10~30$' }
},
],
[
{
left => { name => 'Price'},
right => { value => '30' },
operator => '>',
},
{
condition => 'and',
left => { name => 'Price' },
right => { value => '100' },
operator => '<=',
message => { value => '30~100$' }
},
],
{ message => { value => 'Over 100$' } },
]
}
and on my next run back to
Attribute (whens) does not pass the type constraint because: Validation failed for 'ArrayRefofWhens' with value [ Database::Accessor::Case::When{ close_parentheses: 0, condition: undef, open_parentheses: 0 }, Database::Accessor::Case::When{ close_parentheses: 0, condition: undef, open_parentheses: 0 }, Database::Accessor::Case::When{ close_parentheses: 0, condition: undef, open_parentheses: 0 },
…
Now after a great deal of gnashing of teeth, I found the problem just another typo;
--subtype 'ArrayRefofWhens' => as 'ArrayRef[Whens]';
++subtype 'ArrayRefofWhens' => as 'ArrayRef[When]';
subtype 'ArrayRefofConditions' => as 'ArrayRef[Condition]';
and now I get;
ok 1 - use Database::Accessor::Case;
ok 2 - use Database::Accessor::Case::When;
ok 3 - when is a when
ok 4 - when does role Database::Accessor::Roles::Comparators
ok 5 - case is a case
ok 6 - Cases[0] is a when
so a full pass.
Not bad for today.
Long time Perl guy, a few CPAN mods allot of work on DBD::Oracle and a few YAPC presentations
Leave a comment