6

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.

Lumi
  • 14,775
  • 8
  • 59
  • 92
  • 2
    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. – Lumi Mar 19 '11 at 18:58
  • 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. – Lumi Mar 19 '11 at 22:43
  • 2
    Reading about [Perl Roles Versus Inheritance (chromatic, 2009)](http://www.modernperlbooks.com/mt/2009/05/perl-roles-versus-inheritance.html), I stumbled upon a name and reference for what I tried to convey in my above comment: The [Liskov Substitution Principle](http://c2.com/cgi/wiki?LiskovSubstitutionPrinciple) 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. – Lumi Mar 20 '11 at 10:16
  • 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 – plusplus Jul 28 '11 at 16:57
  • 1
    @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?](http://www.parashift.com/c++-faq-lite/proper-inheritance.html#faq-21.6) 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. – Lumi Jul 28 '11 at 21:48

2 Answers2

5

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.

bvr
  • 9,687
  • 22
  • 28
  • Thanks, that's an improvement. I read [Moose::Manual::Delegation](http://search.cpan.org/~drolsky/Moose-1.24/lib/Moose/Manual/Delegation.pod), which is where the `handles` stuff is explained. But where did you get the `_build_*` trick from? – Lumi Mar 19 '11 at 19:47
  • Ah, never mind, I found it: The `_build_*` stuff is explained in [Moose::Manual::Attributes](http://search.cpan.org/~drolsky/Moose-1.24/lib/Moose/Manual/Attributes.pod). 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](http://search.cpan.org/dist/Mouse/lib/Mouse/Meta/Attribute.pm). All clear now. – Lumi Mar 19 '11 at 19:59
  • @Michael Ludwig - the `_build_*` thing comes from `lazy_build` option. It is combined `lazy` with `builder`. – bvr Mar 19 '11 at 21:09
5

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;
j1n3l0
  • 517
  • 4
  • 16
  • 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? – Lumi Mar 19 '11 at 22:48
  • You're exactly right. Its just scoping, nothing new or especially deep here. – j1n3l0 Mar 19 '11 at 23:06
  • 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. ;-) – Lumi Mar 19 '11 at 23:42