среда, 26 ноября 2008 г.

Многоликие объекты

Иногда Perl обвиняют что у него "неправильные объекты". В ответ так и хочется спросить: "у Вас мания "объектно-ориентированного величия" или вы любитель "священных войн"? Кто сказал, что объекты должны быть основаны только на классах?

Вон в List вообще нет "классических" объектов, зато есть CLOS, которая заткнет за пояс многие объектно-ориентированные языки программирования. А в perl, если не нравятся perl5 объекты можно использовать все что угодно, например:

Moose - A postmodern object system for Perl 5.
Mouse - Moose minus the antlers
Class::Prototyped - Fast prototype-based OO programming in Perl
Class::Closure - Encapsulated, declarative class style
Class::Spiffy - Spiffy Framework with No Source Filtering

А сколько разных генераторов классов есть.

Уверен, что и к perl6 будет претензии: дескать зачем так все сложно, зачем эти
role, если можно все можно сделать наследованием?

Ради бога! Делайте, никто не связывает руки. Perl позволяет многое, почти все. Можно даже использовать нижеследующие:

use strict;
use warnings;

use Clone qw(clone);

sub new {
my $protos = ref $_[0] eq "ARRAY" ? shift || [] : [];
my $data = shift || {};
my $methods = shift || {};

my $self;
return $self = sub {
my $method = shift;

if ($method eq "clone") {
return new(clone($protos), clone($data), clone($methods));
}

if ($method eq "add_slot") {
%{$methods} = (%{$methods}, @_);
return $self;
}

if ($method eq "get_slot") {
return $$methods{$_[0]};
}
if ($method eq "slot_names") {
return keys %$methods;
}

if (my $sub = $$methods{$method}) {
return $sub->($self, $data, @_);
}

foreach (@$protos) {
if (my $sub = $_->("get_slot", $method)) {
return $sub->($self, $data, @_);
}
}
}
}


# Пример использования.

use Test::More tests => 12;

my $c1 = new(
{ foo => 3 },
{
foo => sub { my ($self, $data) = @_;
return $$data{foo};
},
add => sub {
my ($self, $data, $delta) = @_;
$$data{foo} += $delta;
return $self;
},
},
);

is($c1->("foo"), 3, "c1");

my $c2 = $c1->("clone");
is($c2->("foo"), 3, "c2");

ok($c1->("add", 2), "c1: add 2");

is($c1->("foo"), 5, "c1");
is($c2->("foo"), 3, "c2");

is($c1->("add", 3)->("foo"), 8, "c1: add 3 and return");


$c1->("add_slot", multiply => sub {
my ($self, $data, $y) = @_;
$$data{foo} *= $y;
return $self;
});

ok($c1->("multiply", 2), "multiply");
is($c1->("foo"), 16, "multiply, get");

ok(ref $c1->("get_slot", "multiply") eq "CODE", "get_slot");

is(join(" ", sort $c1->("slot_names")), "add foo multiply", "slot_names");



my $c3 = new(
[$c1], # inheritance
{ foo => 3 },
{
baz => sub { my ($self, $data) = @_;
return join " ", "baz", $$data{foo};
},
}
);

is($c3->("baz"), "baz 3", "c3, baz");
is($c3->("foo"), 3, "c3, foo");

Так что, если нечто отличается от привычного, не следует стразу обвинять это нечто в "неправильности", может просто мы столкнулись с тем, что является лишь немного другим. Другим, а не неправильным!

Комментариев нет: