Late Night Moose

In today's Moose-pen we are going to have a look on one of the first my compound Database::Accessor classes 'Database::Accessor::Condition'. By compound I simply mean a class that holds other classes.

The Condition class is just as it sounds a class to add a logical condition to an Accessor. In SQL it would be a 'where' clause and Mongo some of the 'Aggregate' clauses. So basically this is a class that holds a number of 'Predicate' classes. So all I need to add is;

has predicates => (
is => 'rw',
isa => 'ArrayRefofPredicates',
coerce => 1,
alias => 'conditions',
traits => ['Array'],
handles => {
add_predicate => 'push',
count_predicates => 'count',

Now first off I am adding a custom subtype 'ArrayRefofPredicates' which we have aready seen. Now I can save a little code space by jigging my code about a little. All I need to do it the Database::Accessor::Types about and then all my Database::Accesor classs can play with it. This is easily done my moving it out of the 'where' clause of Database::Accessor::Element and into the Database::Accessor::Roles::Base 'where' and thus it will be common to all my classes.

Next is a coerce and we have seen that before as well so no need to explain that in detail.

Then the alias and so far I just have 'conditions' but I could add more like 'Where' in SQL or 'Find' in mongo

Now I am adding in something new a Moose Native Trait. This neat little moose feature allows you delegate to a native Perl data structure as if it was an object. In this case I am telling moose to handle this attributes as if was an Array, and get all sorts of goodies such as count, is_empty, even grep and map.

Moose is even nice enough to allow you to enter you own function names for delegation. In my example I added in add_predicate and count_predicate just for fun. Now what does this look like in my tests? Something like this

my $condition = Database::Accessor::Condition->new(
{predicates=>[{left =>{name=>'field-1',
right =>{name=>'field-2',

Now the only thing I do not like is that operator=>'new' I added in there This should be a logic operator of some sort and looking back on my Predicate class I see I have this

has operator => (
is => 'rw',
isa => 'Str',
default => '='

I think I will and in some more constants and create a type of 'Operator' for that one. So I add in this to my Database::Accessor::Constants file

use constant IN =>'IN';
use constant NOT_IN =>'NOT IN';
use constant BETWEEN =>'BETWEEN';
use constant LIKE =>'LIKE';
use constant IS_NULL =>'IS NULL';
use constant NULL =>'NULL';
use constant IS_NOT_NULL =>'IS NOT NULL';
use constant AND =>'AND';
use constant OR =>'OR';

use constant OPERATORS => {
Database::Accessor::Constants::IN => 1,
Database::Accessor::Constants::NOT_IN => 1,
Database::Accessor::Constants::BETWEEN => 1,
Database::Accessor::Constants::LIKE => 1,
Database::Accessor::Constants::IS_NULL => 1,
Database::Accessor::Constants::IS_NOT_NULL => 1,
Database::Accessor::Constants::AND => 1,
Database::Accessor::Constants::OR => 1,
'=' => 1,
'!='=> 1,
'<>'=> 1,
'>' => 1,
'>='=> 1,
'<' => 1,
'<='=> 1,

then a new subtype in my Database::Accessor::Types;

subtype 'Operator',
as 'Str',
where { exists( Database::Accessor::Constants::OPERATORS->{ uc($_) } ) },
message { "The Operator '$_', is not a valid Accessor Operator!"._try_one_of(Database::Accessor::Constants::OPERATORS()) };

and that just follows the same pattern as my last subtype and finlaly I change my attribute in accessor to

has operator => (
is => 'rw',
-- isa => 'Str',
++ isa => 'Operator',
default => '='

Now I rerun my 18_contition.t tests I get

Attribute (operator) does not pass the type constraint because:
The Operator 'new', is not a valid Accessor Operator!
Try one of '>=', 'LIKE', '<=', '=', '<>', '>', 'IS NULL', 'IN',
'BETWEEN', 'IS NOT NULL', 'AND', '<', 'OR', '!=', 'NOT IN'
at C:\Dwimperl\perl\site
\lib\Moose\ line 24

Hmm not very neat as the order of my 'Try one of' comes up different each time so let me fix that up a little

sub _try_one_of {
my ($hash) = @_;
-- return " Try one of '".join("', '",keys(%{$hash}))."'";
++ return " Try one of '".join("', '",sort(keys(%{$hash})))."'";

and now I get

Attribute (operator) does not pass the type constraint because:
The Operator 'new', is not a valid Accessor Operator!
Try one of '!=', '<', '<=', '<>', '=', '>', '>=', 'AND',
at C:\Dwimperl\perl\site
\lib\Moose\ line 24

each time I run it. Always good to have a consistent error messages.

Now to bed, for I am a sleepy Moose.

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