Как создать циклический график неизменяемых объектов в Perl и Moose?

Question

Это может показаться очевидным безнадежным случаем, но есть ли трюк для создания циклического графика неизменяемых объектов в Perl? Что-то вроде этого:

package Node; 
use Moose; 
has [qw/parent child/] => (is => 'ro', isa => 'Node'); 

package main; 
my $a = Node->new; 
my $b = Node->new(parent => $a); 

Теперь, если я хотел $a->child, чтобы указать на $b, что я могу сделать?

Answer 1

Мне пришлось пойти и посмотреть, как действительно неизменяемые языки делают что-то вроде , и я думаю, что следующая, вероятно, разумная попытка.

use 5.10.0; 
{ 

    package Node; 
    use Moose; 
    has [qw(parent child)] => (isa => 'Node', is => 'ro'); 

    sub BUILD { 
     my ($self, $p) = @_; 
     return unless exists $p->{_child}; 
     my $child = Node->new(parent => $self, %{ delete $p->{_child} },); 
     $self->meta->get_attribute('child')->set_value($self, $child); 
    } 
} 

say Node->new(_child => {})->dump 

В принципе, вместо того, чтобы пытаться строить объекты отдельно, то есть родитель автоматически оживлять ребенок, основанный на переход в его аргументах. Выход для этого - это, я считаю, структуру, которую вы хотели.

$VAR1 = bless({ 
       'child' => bless({ 
            'parent' => $VAR1 
            }, 'Node') 
       }, 'Node'); 

Answer 2

Я все еще очень новичок в лосях, но срабатывал бы триггер?

use Modern::Perl; 

package Node; 
use Moose; 
has 'parent' => (
    is => 'ro', 
    isa => 'Node', 
    trigger => sub{ 
     my ($self, $parent) = @_; 
     $parent->{child} = $self unless defined $parent->child; 
    } 
); 

has 'child' => (
    is => 'ro', 
    isa => 'Node', 
    trigger => sub{ 
     my ($self, $child) = @_; 
     $child->{parent} = $self unless defined $child->parent; 
    } 
); 

package main; 
my $p = Node->new; 
my $c = Node->new(parent => $p); 

say $p, ' == ', $c->parent; 
say $c, ' == ', $p->child; 

Answer 3

Вы можете играть в игры с отложенной инициализации:

package Node; 
use Moose; 

has parent => (
    is => 'ro', 
    isa => 'Node', 
    lazy => 1, 
    init_arg => undef, 
    builder => '_build_parent', 
); 

has _parent => (
    is => 'ro', 
    init_arg => 'parent', 
); 

has child => (
    is => 'ro', 
    isa => 'Node', 
    lazy => 1, 
    init_arg => undef, 
    builder => '_build_child', 
); 

has _child => (
    is => 'ro', 
    init_arg => 'child', 
    predicate => undef, 
); 

has name => is => 'ro', isa => 'Str'; 

Сформировать строителей и предикаты на лету:

BEGIN { 
    for (qw/ parent child /) { 
    no strict 'refs'; 

    my $squirreled = "_" . $_; 

    *{"_build" . $squirreled} = sub { 
     my($self) = @_; 
     my $proto = $self->$squirreled; 
     ref $proto eq "REF" ? $$proto : $proto; 
    }; 

    *{"has" . $squirreled} = sub { 
     my($self) = @_; 
     defined $self->$squirreled; 
    }; 
    } 
} 

Это позволяет

my $a = Node->new(parent => \my $b, name => "A"); 
    $b = Node->new(child =>  $a, name => "B"); 

for ($a, $b) { 
    print $_->name, ":\n"; 
    if ($_->has_parent) { 
    print " - parent: ", $_->parent->name, "\n"; 
    } 
    elsif ($_->has_child) { 
    print " - child: ", $_->child->name, "\n"; 
    } 
} 

Его выход

A: 
    - parent: B 
B: 
    - child: A 

Код может быть более элегантным с η-conversion‎, но Лось не передавать параметры методов строитель.