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.

Shermanshermie

A rectangle has two properties (x and y), but a square has only one (x) of those two, so I'm not sure Square would be a subclass of Rectangle. – Shermanshermie

Certainly, all four sides of equal length. Just think about this OO thing, possibly just some old-fashioned dogma, but who knows? It could also be the wisdom of the ages. Here goes: A sublcass may add properties, but it may not remove properties from a class. So Rectangle has x and y, but Square has only x, removing y. This is no good, according to the old OO dogma. Hence the delegation approach. – Shermanshermie

Reading about Perl Roles Versus Inheritance (chromatic, 2009), I stumbled upon a name and reference for what I tried to convey in my above comment: The Liskov Substitution Principle formulated back in the eighties. There is also a reference to the circle/ellipse problem, which is also referred to as the square/rectangle problem. – Shermanshermie

not sure I agree, you've said that Square is a special case of Rectangle, so make Rectangle the parent class and Square a subclass, override the constructor for Square so that the same value goes to both x and y, and then both Square and Rectangle can have the same methods (area, boundaries, whatever...) - you're not removing a property, a square has both an x and y length, it just enforces them to be the same upon creation – Waly

@plusplus, my example is minimal because the issue here was delegation in Moose, not OO theory. Square and Rectangle cannot "have the same methods (area, boundaries, whatever...)" because, like a circle, a square is essentially constrained by definition. You may doubt this, but please read Is a Circle a kind-of an Ellipse? and the other sections on the circle/ellipse problem. Basically, a rectangle could have widen(d), heighten(d), or setSize(x,y). A square would have to dodge this, or go belly up. – Shermanshermie

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.

Undirected

Thanks, that's an improvement. I read Moose::Manual::Delegation, which is where the handles stuff is explained. But where did you get the _build_* trick from? – Shermanshermie

Ah, never mind, I found it: The _build_* stuff is explained in Moose::Manual::Attributes. Just getting started with this stuff. Ah, wait - the naming convention part (rectangle -> _build_rectangle) is not documented in the Moose manual, but in the Mouse::Meta::Attribute manul page. All clear now. – Shermanshermie

@Michael Ludwig - the _build_* thing comes from lazy_build option. It is combined lazy with builder. – Undirected

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;

Cheat

Thanks! Yeah, as you say, pretty much identical. And right there on the front line with 5.12 and Test::Most - cool! (I'm also on the modernization trip now!) I'm noticing the braces around the packages, though. Seems like a new fashion? I'm wondering what's the deeper reason for doing so? Putting mooses and mice into cages lest they escape in the wild outer scope? – Shermanshermie

You're exactly right. Its just scoping, nothing new or especially deep here. – Cheat

By the way, there is a flaw in your example. A square has only one property, not two. :-) So saying Square->new( 3, 7 ) doesn't make any sense. Certainly just a copy'n'paste error. ;-) – Shermanshermie