Question

Perl的Moose与其他对象系统不同，因此并不总是清楚如何将其他语言中已知的示例翻译成Moose术语。考虑下面的Rectangle和Square的Java示例，其中Square实例（一个正方形是一个特殊的矩形）将对area（）的调用委托给它持有私有引用的Rectangle实例。

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() );
    }
}

我拼凑了下面的Perl / Moose / Mouse版本，我不确定这是正确的做事方式，所以我将它提交给在这些大厅组装的专家公会的判断：

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;

这有效，但由于我没有看到很多Moose在行动，我只是不确定这是要走的路，或者是否有更简单的方法。感谢您提供任何反馈，或指示更多Moose用户级讨论。

Answer 1

虽然我不确定这是最佳做法，但我能想到的最佳翻译可能是这样的：

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);
}

矩形属性中的handles会自动为您建立委派区域。

Answer 2

这就是我和穆斯一起做的事情。它与鼠标版本完全相同：

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;

使用Moose的Perl OO - 编写委派示例的最佳方法？

2 个答案: