Perl OO using Moose - best way to code delegation example?

Question

Perl's Moose is different from other object systems, so it's not always clear how to translate an example known from other languages into Moose lingo. Consider the following Java example of Rectangle and Square, where a Square instance (a square being a special rectangle) delegates calls to area() to an instance of Rectangle to which it hold a private reference.

package geometry;
class Rectangle {
    private int x;
    private int y;
    public Rectangle(int x, int y) {
        this.x = x;
        this.y = y;
    }
    public int area() {
        return x * y;
    }
}
class Square {
    private Rectangle rectangle;
    public Square(int a) {
        this.rectangle = new Rectangle(a, a);
    }
    public int area() {
        return this.rectangle.area();
    }
}
public class Main {
    public static void main( String[] args ) {
        int x, y;
        if ( args.length > 1 ) {
            x = Integer.parseInt( args[0] );
            y = Integer.parseInt( args[1] );
        }
        else {
            x = 3;
            y = 7;
        }
        Rectangle r = new Rectangle( x, y );
        System.out.println( r.area() );
        Square sq1 = new Square( x );
        System.out.println( sq1.area() );
        Square sq2 = new Square( y );
        System.out.println( sq2.area() );
    }
}

I've cobbled together the following Perl/Moose/Mouse version, which I'm not sure is the right way to do things, so I'm submitting it to the judgment of the guild of experts assembled in these halls:

package Rectangle;
use Mouse;
has [ qw( x y ) ], is => 'ro', isa => 'Int';

sub area {
    my( $self ) = @_;
    return $self->x * $self->y;
}

package Square;
use Mouse;
has x => is => 'ro', isa => 'Int';
has rectangle => is => 'ro', isa => 'Rectangle';

# The tricky part: modify the constructor.
around BUILDARGS => sub {
    my $orig = shift;
    my $class = shift;
    my %args = @_ == 1 ? %{ $_[0] } : @_;
    $args{rectangle} = Rectangle->new( x => $args{x}, y => $args{x} );
    return $class->$orig( \%args );
};

sub area { $_[0]->rectangle->area } # delegating

package main;
use strict;
my $x = shift || 3;
my $y = shift || 7;
my $r = Rectangle->new( x => $x, y => $y);
my $sq1 = Square->new( x => $x );
my $sq2 = Square->new( x => $y );
print $_->area, "\n" for $r, $sq1, $sq2;

This works, but as I haven't seen much Moose in action, I'm just not sure this is the way to go, or if there is an even easier way. Thanks for any feedback, or pointers for more Moose user-level discussion.

Answer 1

While I am not sure this is best practice, probably best translation I can think of would be something like this:

package Rectangle;
use Mouse;
has [ qw( x y ) ], is => 'ro', isa => 'Int';

sub area {
    my( $self ) = @_;
    return $self->x * $self->y;
}

package Square;
use Mouse;
has x => is => 'ro', isa => 'Int';
has rectangle =>
    is => 'ro',
    isa => 'Rectangle',
    lazy_build => 1,
    handles => [ 'area' ];

sub _build_rectangle {
    my $self = shift;
    Rectangle->new(x => $self->x, y => $self->x);
}

The handles in rectangle attribute automatically builds delegation to area for you.

Answer 2

This is how I'd do it with Moose. It's pretty much identical to the Mouse version:

use 5.012;
use Test::Most;

{
    package Rectangle;
    use Moose;
    has [qw(x y)] => ( is => 'ro', isa => 'Int' );

    sub area {
        my $self = shift;
        return $self->x * $self->y;
    }
}

{
    package Square;
    use Moose;
    has [qw(x y)] => ( is => 'ro', isa => 'Int' );
    has rectangle =>
        ( isa => 'Rectangle', lazy_build => 1, handles => ['area'] );

    sub _build_rectangle {
        my $self = shift;
        Rectangle->new( x => $self->x, y => $self->y );
    }
}

my @dimensions
    = ( [qw(Rectangle 3 7 21 )], [qw(Square 3 3 9 )], [qw(Square 3 7 21 )] );

for my $dimension (@dimensions) {
    my ( $shape, $x, $y, $area ) = @{$dimension};
    my $rect = new_ok $shape, [ x => $x, y => $y ];
    is $area, $rect->area, "area of $shape ($x, $y) => $area";
}

done_testing;