The Moose Collective

Well in my last post I added a few new attributes to my Database::Accessor::Element class and when playing about bout today I think I will have to revisit one of them 'aggregate'.

If I just leave it as it is

has 'aggregate' => (
is => 'rw',
isa => 'Str',

It will begin to break-down my API as a programmer could come along and enter a very specific Mongo item such as 'mergeObjects' or something odd from an SQL DB like 'DENSERANK' and that makes for a very inconstant API.

So I am just going to bite the bullet and add in a 'Type' for this attribute so lets have a look at that.

Well to start I will have to narrow down what I want aggregate to mean. In Mongo it is a command word with some thirty+ operators and in SQL, depending on the DB, as few as five to many more than Mongo. So after a few hours of reading and revising I came up with this short list;

  • Average
  • Count
  • Max
  • Median
  • Min
  • Sum

A very short list indeed but that coves off most usage in both SQL and Mongo. Now to implement this type.

So the first thing to do is come up with a type name and I am might as well keep it the same and call it 'Aggregate' so now I have

has 'aggregate' => (
is => 'rw',
isa => 'Aggregate',

Now I have to add in that into my Types role. I am going to get off the Moose path for a few mins and go back to good old plain perl and create a 'Constants' class. I am one who hates to see things like this

if ($flag == 1){


if ($hash->{speed} eq 'SLOW')

majik numbers and words, hate them with a passion. So in my Constants file I do this

package Database::Accessor::Constants;
use warnings;
use strict;
$Database::Accessor::Constants::VERSION = "0.01";
use constant AVG =>'AVG';
use constant COUNT =>'COUNT';
use constant MEDIAN =>'MEDIAN';
use constant MAX =>'MAX';
use constant MIN =>'MIN';
use constant SUM =>'SUM';
use constant AGGREGATES =>{
Database::Accessor::Constants::AVG =>1,
Database::Accessor::Constants::COUNT =>1,
Database::Accessor::Constants::MEDIAN =>1,
Database::Accessor::Constants::MAX =>1,
Database::Accessor::Constants::MIN =>1,
Database::Accessor::Constants::SUM =>1,};

So I have one constant for each of my keys and then a hash to hold them all.

So now back into Moose. In my atabase::Accessor::Types first I add in the constants file

use Moose::Util::TypeConstraints;
++use Database::Accessor::Constants;

and then a new subtype called 'Aggregate'

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

Now what am I doing here. Moose lets us expand on subtype with the 'where' option and in this call we have the '$_', the value coming into the attribute, and we can test this.

So all I do is test to see if the incoming '$_' is a key in my AGGREGATES hash. Now I use the 'uc' function here to make my API a little more user friendly but still work. If the incoming upper case '$_' is there then '1' is returned and the type passes. If it fails Moose gives us the 'message' call where we can give a nice neat error message.

In this case I added in a new function.

sub _try_one_of {
    my ($hash) = @_;
    return " Try one of '".join("', '",keys(%{$hash}))."'";     
that I can reuse later on in other 'subtypes' of the same style. The above give me this nice standard message
Attribute (aggregate) does not pass the type constraint because: The Aggrerate 'Avgx', is not a valid Accessor Aggregate! Try one of 'MIN', 'MAX', 'AVG', 'MEDIAN', 'COUNT', 'SUM' at accessor Database::Accessor::Element::aggregate ...

Now a quick test of this I can add this in

ok($street->aggregate('Avg'),'can do an Average');
eval {
ok($street->aggregate('Avgx'),'can do an Avgx');
if ($@){
pass("Element aggregate can not be Avgx");
else {
fail("Element aggregate can not be Avgx");

and I get this

ok 5 - can do an Average ok 6 - Element aggregate can not be Avgx

So I get what I want. Now onto something different for tomorrow


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