Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How can I overload Moose constructors?

Tags:

perl

moose

Sorry for the Java jargon, but how can I overload Moose constructors?

Suppose I'm representing a segment. I can either take a start point and and point, or a start point and length, or end point and length.

How can I allow for such alternative construction methods?

like image 291
David B Avatar asked Oct 23 '10 11:10

David B


2 Answers

You don't need to override new. You can supply your own BUILD:

#!/usr/bin/perl

package My::Segment;

use Moose;
use namespace::autoclean;
use Carp qw( confess );

has 'start' => (is => 'ro', isa => 'Num',
    predicate => 'has_start', writer => '_set_start',
);

has 'end' => (is => 'ro', isa => 'Num',
    predicate => 'has_end', writer => '_set_end',
);

has 'length' => (is => 'ro', isa => 'Num',
    predicate => 'has_length', writer => '_set_length',
);

sub BUILD {
    my $self = shift;

    $self->has_start and $self->has_end and $self->length and do {
        return if $self->length == $self->end - $self->start;
        confess "Inconsistent start, end and length";
    };

    $self->has_start and $self->has_end and do {
        $self->_set_length($self->end - $self->start);
        return;
    };
    $self->has_start and $self->has_length and do {
        $self->_set_end($self->start + $self->length);
        return;
    };
    $self->has_end and $self->has_length and do {
        $self->_set_start($self->end - $self->length);
        return;
    };
    confess "At least two of start, end or length must be supplied";
}

__PACKAGE__->meta->make_immutable;

package main;
use YAML;

my $x = My::Segment->new(start => 0, length => 3);
my $y = My::Segment->new(start => 1, end => 4);
my $z = My::Segment->new(end => 5, length => 3);

print Dump($_) for $x, $y, $z;

my $w = My::Segment->new(start => 0, end => 0, length => 1);
like image 97
Sinan Ünür Avatar answered Oct 10 '22 01:10

Sinan Ünür


Sinan's BUILD answer is probably the sanest most straight forward solution. Using BUILDARGS as dave mentioned is also a reasonable solution.

I felt it worth mentioning that one could use Type Coercions as well. Given a class:

class LineSegment { 
  has [qw(startX startY endX endY)] => ( 
         isa => 'Num', 
         is  => 'ro', 
         required => 1 
  );
}

You can use a set of coercions like so:

class_type 'LineSegment';

subtype StartLength 
     => as Hashref 
     => where { exists $_->{startX} && $_->{startY} && $_->{length} };

subtype EndLength 
     => as Hashref 
     => where { exists $_->{endX} && $_->{endY} && $_->{length} };    

coerce LineSegment 
     => from StartLength 
     => via { my ($endX, $endY) = calc_end($_); 
              LineSegment->new(
                   startX => $_->{startX}, 
                   startY => $_->{startY},
                   endX => $endX,
                   endY => $endY,
            )};
coerce LineSegment 
     => from EndLength 
     => via { my ($startX, $startY) = calc_start($_); 
              LineSegment->new(
                   startX => $startX, 
                   startY => $startY,
                   endX => $_->{endX},
                   endY => $_->{endY},
            )};               

Then in your code:

 use Moose::Util::TypeConstraints;
 find_type_constraint('LineSegment')->coerce({
       startX => $x, 
       startY => $y, 
       length => $length
 });

While perhaps overkill for this example, there are several times when a coercion is an elegant solution. For example if you have a pre-existing LineSegment class you wish to not add a length attribute to (though BUILDARGS would work well there too)

like image 21
perigrin Avatar answered Oct 10 '22 00:10

perigrin