Search code examples
perlmoosetype-constraints

Moose construct objects from single arguments


I've been dabbling with Moose for about seven months and Perl only slightly longer, but can't figure out how you can construct several attributes in a class by just supplying one argument for each, instead of a whole hashref of them. I've searched the documentation and the web extensively, but I'm either looking for the wrong words or missing something.

I've adapted the design to be more generic. With the following basic setup:

package First;
use Moose;
use Second::Type1;
use Second::Type2;
has 'type1' => (
  is => 'rw',
  isa => 'Second::Type1',
  default => sub {Second::Type1->new(name => 'random')}
);

has 'type2' => (
  is => 'rw',
  isa => 'Second::Type2',
  default => sub {Second::Type2->new(name => 'random')}
);

package Second::Type1;
use Moose;
use This;
has 'name' => (
  is => 'rw',
  isa => 'Str',
  required => 1,
);
has 'this' => (
  is => 'rw',
  isa => 'This',
  default => sub {This->new()}
);
# package has more attributes, but you get the idea
__PACKAGE__->meta->make_immutable();
no Moose;
1;

package Second::Type2;
use Moose;
use That;
has 'name' => (
  is => 'rw',
  isa => 'Str',
  required => 1,
);
has 'that' => (
  is => 'rw',
  isa => 'That',
  default => sub {That->new()}
);
# package has more attributes, but you get the idea
__PACKAGE__->meta->make_immutable();
no Moose;
1;

I want to be able to construct a First by saying:

use First;
my $first = First->new(type1 => 'foo', type2 => 'bar');

where 'foo' equals the value for Second::Type1's 'name' attribute and 'bar' equals the value for Second::Type2's 'name' attribute.

Now as to my own solution, I've (successfully) made a Moose::Role which only contains an 'around BUILDARGS' sub and then using a Factory class (the contents of which aren't relevant here IMO):

package Role::SingleBuildargs;

use Moose::Role;
use Factory::Second;
requires 'get_supported_args';

around BUILDARGS => sub {
my ($class, $self, %args) = @_;
my @supported_args = $self->get_supported_args;
my $factory = Factory::Second->new();
    my @errors = ();
    foreach my $arg (sort {$a cmp $b} keys %args) {
        if (grep {$_ eq $arg} @supported_args) {
            my $val = $args{$arg};
            if (!ref $val) {    # passed scalar init_arg
                print "$self (BUILDARGS): passed scalar\n";
                print "Building a Second with type '$arg' and name '$val'\n";
                $args{$arg} = $factory->create(type => $arg, name => $val)
            } elsif (ref $val eq 'HASH') {  # passed hashref init_arg
                print "$self (BUILDARGS): passed hashref:\n";
                my %init_args = %$val;
                delete $init_args{name} unless $init_args{name};
                $init_args{type} = $arg;
                $args{$arg} = $factory->create(%init_args);
            } else {    # passed another ref entirely
                print "$self (BUILDARGS): cannot handle reference of type: ", ref $val, "\n";
                die;
            }
        } else {
            push @errors, "$self - Unsupported attribute: '$arg'";
        }
    }
    if (@errors) {
        print join("\n", @errors), "\n";
        die;
    }
    return $self->$class(%args);
    };

no Moose;
1;

and then I use that Role in the First class and other classes like First.

I've also tried coercing via:

package Role::Second::TypeConstraints;
use Moose::Util::TypeConstraints

subtype 'SecondType1', as 'Second::Type1';
subtype 'SecondType2', as 'Second::Type2';
coerce 'SecondType1', from 'Str', via {Second::Type1->new(name => $_};
coerce 'SecondType2', from 'Str', via {Second::Type2->new(name => $_};

no Moose::Util::TypeConstraints;
1;

and modified the First package (listing only changes):

use Role::Second::TypeConstraints;
has 'type1' => (
   isa => 'SecondType1',
   coerce => 1,
);
has 'type2' => (
   isa => 'SecondType2',
   coerce => 1,
);    

That, however didn't work. If someone could explain why, that would be great.

As to the actual question: what is the best way to obtain this kind of behaviour in your classes? Is there really no better way than modifying BUILDARGS, or did I miss something (about Moose::Util::TypeConstraints, perhaps)? TMTOWTDI and all, but mine doesn't seem efficient at all.

EDIT: edited for consistency (mixed up generic class names)


Solution

  • You can do exactly as you describe using coercion

    • Add

      use Moose::Util::TypeConstraints;
      

      to First, Second::Type1 and Second::Type2

    • Add a coercion action to Second::Type1

      coerce 'Second::Type1'
          => from 'Str'
              => via { Second::Type1->new( name => $_ ) };
      

      and to Second::Type2

      coerce 'Second::Type2'
          => from 'Str'
              => via { Second::Type2->new( name => $_ ) };
      
    • Enable coercion for the type1 and type2 attributes of First

      has 'type1' => (
        is      => 'rw',
        isa     => 'Second::Type1',
        default => sub { Second::Type1->new },
        coerce  => 1,
      );
      
      has 'type2' => (
        is      => 'rw',
        isa     => 'Second::Type2',
        default => sub { Second::Type2->new },
        coerce  => 1,
      );
      

    Then you can create a First object exactly as you say, with

    my $first = First->new(type1 => 'foo', type2 => 'bar');