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';

Comments

The constructor offers a backdoor past the constraint: Person->new(birthday => 42);

This brings up a question I wish I had a mentor to ask about. I often see classes defined as above where an uninitialized object is allowed and code will use setters to gradually build up the object. It's a style I think suboptimal but I am the junior developer here so I try to keep quiet about it usually.

What if one had a coding style that demanded that a class's constructor fully populate an object's attributes and used constraints where that's helpful. It would have the nice property that you never have an object created that's either empty or initialized with bad data. You would detect the bad parameter variable in your ctor and refuse to return your object when it's not valid. Are there drawbacks to that policy?

Even when I did C++, where I worked there would be do nothing constructors and objects that transition from uninitialized through semi-initialized to fully initialized. This gives up the nice property of a ctor that it can establish class invariants from the point it returns onwards to destruction. But perhaps there are practical reasons for wanting empty objects of a given type.

---

You are right about the backdoor. This code should be improved. In Perl you can't stop someone from creating a broken instance, (as they can themselves bless any reference into any class), but it sound reasonable to require that use passes all the attributes that are really needed for the object to have any meaning.