Come si crea un grafico ciclico di oggetti immutabili in Perl e Moose?

Question

Questo potrebbe sembrare un caso ovviamente senza speranza, ma esiste un trucco per creare un grafico ciclico di oggetti immutabili in Perl? Qualcosa di simile a questo:

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

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

Ora, se volevo $a->child per puntare a $b, cosa posso fare?

Answer 1

Ho dovuto andare a vedere come lingue veramente immutabili fanno qualcosa come questo, e penso che il seguente è probabilmente un tentativo ragionevole.

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 

In sostanza, invece di cercare di costruire gli oggetti separatamente, avete il genitore auto-vivificare il bambino sulla base di passaggio in esso è argomenti. L'output per questo è, che credo sia la struttura che volevi.

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

Answer 2

Sono ancora molto nuovo a Moose, ma un trigger funziona?

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

Si potrebbe giocare con l'inizializzazione pigra:

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'; 

generare i costruttori e predicati al volo:

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

Questo permette

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

La sua uscita è

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

Il codice potrebbe essere più elegante, con η-conversion‎, ma Moose non passerà i parametri ai metodi costruttore.