[ Perl tips index ]
[ Subscribe to Perl tips ]
This tip continues where we left off in our previous tip.
Our existing PlayingCard class in Moose doesn't do any sort
of validation of the card suit or value. While we could write our
own code to manually validate these values, a much more flexible
approach is to define our own types for Moose.
use Moose::Util::TypeConstraints;
# Turn programmer input into a canonical representation
# We're assuming here that we've lower-cased first
my %String_to_suit = (
s => 's',
spades => 's',
spade => 's',
h => 'h',
hearts => 'h',
heart => 'h',
...
);
# Turn programmer input into a canonical representation
# 2-9 remain untouched, 10, J, Q, K, A are adjusted.
my %String_to_value = (
( map { lc($_) => $_ } (2..9, qw(T J Q K A) ) ),
10 => 'T',
jack => 'J',
queen => 'Q',
king => 'K',
ace => 'A',
);
# Define our sub-types. A Suit can only be h, d, c or s
subtype 'Suit'
=> as 'Str'
=> where { /^[hdcs]/ };
subtype 'CardValue'
=> as 'Str'
=> where { /^[2-9AKQJT]$/ };
# Define our coercions. To get a Suit from the value passed in,
# use the code in the via block (which references our hashes above)
coerce 'Suit'
=> from 'Str'
=> via { $String_to_suit{lc $_} };
coerce 'CardValue'
=> from 'Str'
=> via { $String_to_value{lc $_} };
The above code can be placed into any file, provided it is
used before any attributes that depend upon it. In the case of
our PlayingCard class, it could go into the same file as the
class definition itself. For a more complex project, where
types may be used by multiple classes, it's best to put type
definitions into a separate file and use it from the classes
that need them.
package PlayingCard;
use Moose;
use CardTypes;
has 'suit' => (
is => 'ro',
isa => 'Suit',
required => 1,
coerce => 1,
);
has 'value' => (
is => 'ro',
isa => 'CardValue',
required => 1,
coerce => 1
);
no Moose;
1;
The coerce parameter is required to tell Moose that it's okay
to coerce from a compatible type. Without this, Moose won't try
to turn our strings into Suits and CardValues.
The next Perl Tip on Moose will cover inheritance and roles.
[ Perl tips index ]
[ Subscribe to Perl tips ]
This Perl tip and associated text is copyright Perl Training Australia. You may freely distribute this text so long as it is distributed in full with this Copyright noticed attached.
If you have any questions please don't hesitate to contact us:
| Email: | contact@perltraining.com.au |
| Phone: | 03 9354 6001 (Australia) |
| International: | +61 3 9354 6001 |
Copyright 2001-2012 Perl Training Australia. Contact us at contact@perltraining.com.au
