Question

This follows on from my previous question about Moose structured types. I apologise for the length of the question. I wanted to ensure that I included all the necessary details.

MyApp::Type::Field defines a structured type. I use coercion to allow its value attribute to be set more easily from my Person class (see example below). Note that in my real application, where the Field type is used for more than just a person’s name, I also coerce from a HashRef.

I also need to set the MyApp::Type::Field size and required read-only attributes from MyApp::Person at build time. I can do this using a builder method, but this is not called if coercion is used, as my coercion creates a new object directly, without using the builder method.

I can get round this by adding an around method modifier to MyApp::Person (see example below), but this feels messy. The around method modifier is called frequently, but I only need to set the read-only attributes once.

Is there a better way to do this, whilst still allowing coercion? The MyApp::Type::Field class cannot initialize size and required via defaults or builders, as it has no way of knowing what the values should be.

It may simply be the case that I forgo coercion in favour of having no around modifier.

MyApp::Type::Field

coerce 'MyApp::Type::Field'
    => from 'Str'
        => via { MyApp::Type::Field->new( value => $_ ) };

has 'value'    => ( is => 'rw' );
has 'size'     => ( is => 'ro', isa => 'Int',  writer => '_set_size',     predicate => 'has_size' );
has 'required' => ( is => 'ro', isa => 'Bool', writer => '_set_required', predicate => 'has_required' );

MyApp::Person

has name => ( is => 'rw', isa => 'MyApp::Type::Field', lazy => 1, builder => '_build_name', coerce  => 1 );       

sub _build_name {
    print "Building name\n";
    return MyApp::Type::Field->new( size => 255, required => 1 );
}

MyApp::Test

print "Create new person with coercion\n";
my $person = MyApp::Person->new();
print "Set name\n";
$person->name( 'Joe Bloggs' );
print "Name set\n";
printf ( "Name: %s [%d][%d]\n\n", $person->name->value, $person->name->size, $person->name->required );

print "Create new person without coercion\n";
$person = MyApp::Person->new();
print "Set name\n";
$person->name->value( 'Joe Bloggs' );
print "Name set\n";
printf ( "Name: %s [%d][%d]\n\n", $person->name->value, $person->name->size, $person->name->required );

Prints:

Create new person with coercion
Set name
Name set
Name: Joe Bloggs [0][0]

Create new person without coercion
Set name
Building name
Name set
Name: Joe Bloggs [255][2]

Add an around method modifier to MyApp::Person, and change the builder so that it doesn’t set size and required:

around 'name' => sub {
    my $orig = shift;
    my $self = shift;

    print "Around name\n";

    unless ( $self->$orig->has_size ) {
        print "Setting size\n";
        $self->$orig->_set_size( 255 );
    };

    unless ( $self->$orig->has_required ) {
        print "Setting required\n";
        $self->$orig->_set_required( 1 );
    };

    $self->$orig( @_ );
};

sub _build_name {
    print "Building name\n";
    return MyApp::Type::Field->new();
}

When MyApp::Test is run, size and required are set twice.

Create new person with coercion
Set name
Around name
Building name
Setting size
Setting required
Name set
Around name
Setting size
Setting required
Around name
Around name
Name: Joe Bloggs [255][3]

Create new person without coercion
Set name
Around name
Building name
Name set
Around name
Around name
Around name
Name: Joe Bloggs [255][4]

Proposed solution

daotoad’s suggestion of creating a subtype for each MyApp::Person attribute, and coercing that subtype from a Str into a MyApp::Type::Field works quite well. I can even create multiple subtypes, coercions and attributes by wrapping the whole lot in a for loop. This is very useful for creating multiple attributes with similar properties.

In the example below, I have set up delegation using handles, so that $person->get_first_name is translated to $person->first_name->value. Adding a writer gives provides an equivalent setter, making the interface to the class quite clean:

package MyApp::Type::Field;

use Moose;

has 'value'     => (
    is          => 'rw',
);

has 'size'      => (
    is          => 'ro',
    isa         => 'Int',
    writer      => '_set_size',
);

has 'required'  => (
    is          => 'ro',
    isa         => 'Bool',
    writer      => '_set_required',
);

__PACKAGE__->meta->make_immutable;
1;

package MyApp::Person;
use Moose;
use Moose::Util::TypeConstraints;
use namespace::autoclean;

{
    my $attrs = {
        title      => { size =>  5, required => 0 },
        first_name => { size => 45, required => 1 },
        last_name  => { size => 45, required => 1 },
    };

    foreach my $attr ( keys %{$attrs} ) {

        my $subtype = 'MyApp::Person::' . ucfirst $attr;

        subtype $subtype => as 'MyApp::Type::Field';

        coerce $subtype
           => from 'Str'
               => via { MyApp::Type::Field->new(
                   value    => $_,
                   size     => $attrs->{$attr}{'size'},
                   required => $attrs->{$attr}{'required'},
               ) };

        has $attr   => (
            is      => 'rw',
            isa     => $subtype,
            coerce  => 1,
            writer  => "set_$attr",
            handles => { "get_$attr" => 'value' },
            default => sub {
                MyApp::Type::Field->new(
                    size     => $attrs->{$attr}{'size'},
                    required => $attrs->{$attr}{'required'},
                )
            },
        );
    }
}

__PACKAGE__->meta->make_immutable;
1;

package MyApp::Test;

sub print_person {
    my $person = shift;

    printf "Title:      %s [%d][%d]\n" .
           "First name: %s [%d][%d]\n" .
           "Last name:  %s [%d][%d]\n",
           $person->title->value || '[undef]',
           $person->title->size,
           $person->title->required,
           $person->get_first_name || '[undef]',
           $person->first_name->size,
           $person->first_name->required,
           $person->get_last_name || '[undef]',
           $person->last_name->size,
           $person->last_name->required;
}

my $person;

$person = MyApp::Person->new(
    title      => 'Mr',
    first_name => 'Joe',
    last_name  => 'Bloggs',
);

print_person( $person );

$person = MyApp::Person->new();
$person->set_first_name( 'Joe' );
$person->set_last_name( 'Bloggs' );

print_person( $person );

1;

Prints:

Title:      Mr [5][0]
First name: Joe [45][6]
Last name:  Bloggs [45][7]
Title:      [undef] [5][0]
First name: Joe [45][8]
Last name:  Bloggs [45][9]

Answer 1

Is every person going to have different requirements for the name field? This seems unlikely.

It seems more likely that you have a set of parameters for each Field accross the application. So define a type PersonName as a subtype of Field. Your coercion would be from string to PersonName. Then the coercion code and can apply the appropriate values to required and length when it calls Field->new().

Also, this really seems like you are building an attribute object for a Moose object, which is based on a meta-object system that already provides attribute objects. Why not extend your attribute object rather than make your own?

See the Moose Cookbook Meta Recipes for more info on this approach.