Moose coercion and builders

Question

Ceci fait suite à mon previous question sur les types structurés Moose. Je m'excuse pour la longueur de la question. Je voulais m'assurer d'avoir inclus tous les détails nécessaires.

MyApp::Type::Field définit un type structuré. J'utilise la coercition pour permettre à son attribut value d'être défini plus facilement à partir de ma classe Person (voir l'exemple ci-dessous). Notez que dans mon application réelle, où le type de champ est utilisé pour plus que le nom d'une personne, je force aussi à partir d'un HashRef.

Je dois également définir les attributs MyApp::Type::Fieldsize et required en lecture seule de MyApp::Person lors de la génération. Je peux le faire en utilisant une méthode de construction, mais cela n'est pas appelé si la coercition est utilisée, car ma coercition crée un nouvel objet directement, sans utiliser la méthode du constructeur.

Je peux contourner cela en ajoutant un modificateur de méthode around à MyApp::Person (voir l'exemple ci-dessous), mais cela semble salissant. Le modificateur de méthode around est appelé fréquemment, mais j'ai seulement besoin de définir les attributs en lecture seule une fois.

Existe-t-il un meilleur moyen de le faire, tout en autorisant la coercition? La classe MyApp::Type::Field ne peut pas initialiser size et required via des valeurs par défaut ou des constructeurs, car elle n'a aucun moyen de savoir quelles devraient être les valeurs.

Il se peut simplement que je renonce à la coercition en faveur de n'avoir aucun around modificateur.

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] 

Ajouter un modificateur de la méthode around-MyApp::Person, et changer le constructeur afin qu'il ne fixe pas size et 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(); 
} 

Lorsque MyApp::Test est exécuté, size et required sont mis deux fois.

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] 

Solution proposée

daotoad's suggestion de créer un sous-type pour chaque attribut MyApp::Person, et ce sous-type de contraindre un Str dans un MyApp::Type::Field fonctionne très bien. Je peux même créer plusieurs sous-types, coercions et attributs en enveloppant tout le lot dans une boucle for. Ceci est très utile pour créer plusieurs attributs avec des propriétés similaires.

Dans l'exemple ci-dessous, j'ai configuré la délégation en utilisant handles, de sorte que $person->get_first_name soit converti en $person->first_name->value. Ajout d'un écrivain donne fournit un setter équivalent, ce qui rend l'interface à la classe tout à fait propre:

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

Est-ce chaque personne va avoir des exigences différentes pour le domaine name? Cela semble improbable.

Il semble plus probable que vous ayez un ensemble de paramètres pour chaque Field à travers l'application. Définissez donc un type PersonName en tant que sous-type de Field. Votre coercition serait de chaîne à PersonName. Ensuite, le code de coercition et peut appliquer les valeurs appropriées à la longueur requise et quand il appelle Field->new(). De plus, cela ressemble vraiment à la construction d'un objet attribut pour un objet Moose, qui est basé sur un système de méta-objets qui fournit déjà des objets attributs. Pourquoi ne pas étendre votre objet d'attribut plutôt que de créer le vôtre? Voir le Moose Cookbook Meta Recipes pour plus d'informations sur cette approche.