Perl, Moose, обработка атрибутов

Question

[Вячеслав Голованов]

Заплутал я в богатом лесу возможностей Moose.

Как мне обработать атрибут после его установки через attribute accessor или constructor?

Допустим, есть:

package MyMod;
use Moose;

has 'page' => (
  is => 'rw',
  required => 1,
);

Нужно после того, как этот атрибут устанавливают через

$mm = MyMod->new( page => 'abcd/efgh');

или

$mm->page('fghj/asdf');

каким-то образом его каждый раз изменять. Удалять из него символы "/", например.

Answer 1

[zdm001]

has 'page'  => (is => 'rw', isa => 'Str');
has '_page' => (is => 'rw', isa => 'Str', lazy_build => 1);

sub _build__page {
    my $self = shift;
    return $self->{page} =~ s/^.+\/(.+)$/$1/r;
}

around 'page' => sub {
    my $orig = shift;
    my $self = shift;

    if (@_) {
        $self->$orig(@_);
        $self->_clear_page;
    }
    return $self->_page;
};

Так, как у тебя, тоже нормально.

Comments

[Вячеслав Голованов]

Хм, этот вариант более красив. Как-то он более moose-way, более объектный.
Я сейчас осваиваю ооп, поэтому мне пока сложно мыслить в этом направлении, когда многие вещи происходят «самостоятельно», главное их в правильном месте описать.

Answer 2

[zdm001]

1. сразу обработать значение аттрибута, установленное через конструктор (new), можно только в методе BUILDARGS (получаем доступ к хешу аттрибутов перед созданием объекта) или BUILD (обрабатываем аттрибуты сразу после создания объекта), модификаторы методов (before, around, trigger) не вызываются при установке аттрибута в конструкторе;
2. можно использовать trigger (вызывается, когда устанавливается значение);
3. можно использовать around, при каждом вызове проверять и изменять значение, если надо;

Comments

[Вячеслав Голованов]

Я думал, есть какой-то один метод для конструктора и для аксессора.

Через триггер у меня не получается,- похоже, он не позволяет менять значение атрибутов.

Вроде бы получается, что надо в двух местах делать — через BUILD и через around.

Answer 3

[zdm001]

Через триггер значение менять нельзя, он вызывается после установки значения. Можно только понять, было значение изменено или нет.
Если в триггере обратиться к $self->page('xxx') — будет бесконечная рекурсия.
Нужно так в триггере: $self->{page} = 'xxx' — это прямое обращение к аттрибуту класса в perl, минуя модификаторы методов Moose. В этом случае рекурсии не будет, т.к. триггер не вызовется второй раз сам из себя.

Можно делать только через around, он сработает в любом случае, когда ты будешь получать значение аттрибута. Тогда в around нужно будет каждый раз делать подстановку при получении значения или завести отдельный метааттрибут, в котором хранить флаг — обработона значение или нет…

Других путей нет, из new модификаторы не вызываются, в этом все дело.

Можно еще так:)))
Завести доп. аттрибут _page и в нем хранить измененное значение. Сделать его lazy_build => 1.
Создать билдер _page:

sub _build__page {
    my $self = shift;
    return $self->{page} =~ s/\///g; #именно так, чтобы не возникало рекурсии при вызове из around ниже
}

В around к page:

if(@_){ #если устанавливаются параметры - очищаем _page, чтобы при следующем обращении вызвался его билдер
    $self->_clear_page;
}
$self->$orig(@_); #проксируем на оригинальный метод
return $self->_page;#если мы меняем значение - будет вызван билдер для _page, его результат сохранится в _page и вернется, если не меняем вернется значение _page, которое там было раньше, второй раз код подмены для одного и того-же значения выполнятся не будет

Это самый элегантный вариант.

Answer 4

[zdm001]

оптимизированный around:

if(@_){
$self->_clear_page;
$self->$orig(@_); #проксируем на оригинальный метод только если значение устанавливается
}
return $self->_page;

Answer 5

[zdm001]

В билдере ошибка, надо:

return $self->{page} =~ s/\///gr;

модификатор r обязателен к регэкспу, чтобы вернулся результат замены, а не кол-во произведенных замен

Comments

[Вячеслав Голованов]

Спасибо за подсказки, вроде бы разобрался.

Сделал так:

sub BUILD {
  my( $self ) = @_;

  $self->{page} = $self->_parse_page( $self->{page} );
}

around 'page' => sub {
  my( $orig, $self, $page ) = @_;

  my $parsed = $page;

  return $self->$orig() if ( !$parsed );

  $parsed = $self->_parse_page( $parsed );
  $self->$orig( $parsed );
};

sub _parse_page {
  my( $self, $page ) = @_;
  my $parsed = $page;
  $parsed =~ s/^.+\/(.+)$/$1/;
  $parsed
}

build для конструктора, around для аксессора, и общая функция изменения содержимого page (оставляет только то, что после последнего "/" в строке).