Perl OO с использованием Moose - лучший способ делегирования кода - PullRequest
Новая
       21

Perl OO с использованием Moose - лучший способ делегирования кода

6 голосов
/ 19 марта 2011

Perl's Moose отличается от других объектных систем, поэтому не всегда понятно, как перевести пример, известный из других языков, на язык Moose. Рассмотрим следующий пример Java для Rectangle и Square, где экземпляр 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.

Ответы [ 2 ]

5 голосов
/ 19 марта 2011

Вот как бы я это сделал с Музом.Это в значительной степени идентично версии для мыши: 

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;
5 голосов
/ 19 марта 2011

Хотя я не уверен, что это лучшая практика, вероятно, лучший перевод, о котором я могу подумать, будет выглядеть примерно так: 

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 в прямоугольнике автоматически создает делегирование в область для вас.

...