In this example we are going to use a regular Perl class as a type constraint. In the Moose version of the series we used a DateTime object as a type constraint. Classes as constraints in Moose Implementing it in core Perl is quite similar to the previous cases. For example when we had accessor with type constraint.

examples/oop/person03/lib/Person.pm



package Person; use strict; use warnings; use Scalar::Util qw(blessed); sub new { my ($class, %args) = @_; my $self = \%args; bless $self, $class; return $self; } sub name { my ($self, $value) = @_; if (@_ == 2) { $self->{name} = $value; } return $self->{name}; } sub birthday { my ($self, $value) = @_; if (@_ == 2) { die qq{Attribute (birthday) does not pass the type constraint because:} . qq{Validation failed for 'DateTime' with value 1988 at accessor} if not blessed $value or not $value->isa('DateTime') ; $self->{birthday} = $value; } return $self->{birthday}; } 1;

In the birthday setter/getter we add a die ... if not ... construct.

First we check if the given parameter is a blessed reference, that is if it is an instance of anything. Then we check if it is a instance of DateTime using the appropriately named isa method from the UNIVERSAL package. We need to have this 2-step checking as the isa method calling would throw an exception if the variable $value did not contain an object.

The blessed function comes from the Scalar::Util module.

Script

Sample script to use the module:

examples/oop/person03/script/person.pl



use strict; use warnings; use v5.10; use Person; use DateTime; my $student = Person->new( name => 'Foo' ); $student->birthday( DateTime->new( year => 1988, month => 4, day => 17) ); say $student->birthday; $student->birthday(1988);

Test

Test to verify the module and the birthday setter:

examples/oop/person03/t/01-name.t



use strict; use warnings; use v5.10; use DateTime; use Test::More tests => 7; use Test::Exception; use Person; my $p = Person->new; isa_ok($p, 'Person'); is($p->name('Foo'), 'Foo', 'setter'); is($p->name, 'Foo', 'getter'); isa_ok( $p->birthday( DateTime->new( year => 1988, month => 4, day => 17) ), 'DateTime'); my $d = $p->birthday; isa_ok($d, 'DateTime'); is($d->year, 1988, 'year is correct'); my $default_err = qr{Attribute \(birthday\) does not pass the type constraint because:}; my $homemade_err = qr{Validation failed for 'DateTime' with value 1988}; throws_ok { $p->birthday( 1988 ) } qr{$default_err $homemade_err}, 'Year as birthday';