notes/strong-and-weak.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Devel::GlobalDestruction ();
   6 use Scalar::Util ();
   7 use Variable::Magic ();
   8 use Carp ();
   9
  10 BEGIN {
  11   package Foo;
  12
  13   my $wiz;
  14   $wiz = Variable::Magic::wizard
  15     data => sub { $_[1] },
  16     get => sub {
  17       Carp::cluck "get fired";
  18       Scalar::Util::weaken($_[1]->{reference}{other_side} = ${$_[0]});
  19       Scalar::Util::weaken($_[1]->{reference});
  20       Variable::Magic::dispell ${$_[0]}, $wiz;
  21     };
  22
  23   sub DESTROY {
  24     return if Devel::GlobalDestruction::in_global_destruction();
  25     Carp::cluck "DESTROY\n";
  26
  27     my $self = shift;
  28
  29     if (ref $self->{other_side} && $self->{other_side}{reference}) {
  30       if (
  31         Scalar::Util::refaddr($self->{other_side}{reference})
  32         eq Scalar::Util::refaddr($self)
  33       ) {
  34         warn "Enlivening";
  35         $self->{other_side}{reference} = $self;
  36         Variable::Magic::cast(
  37           $self->{other_side}{reference}, $wiz, $self->{other_side}
  38         );
  39         delete $self->{other_side};
  40       }
  41     }
  42   }
  43 }
  44
  45 my $near = {};
  46 my $far = $near->{reference} = bless({ other_side => $near }, 'Foo');
  47 warn $near->{reference};
  48 warn $far;
  49 Scalar::Util::weaken($near->{reference});
  50 warn "Setup done\n";
  51 undef($far);
  52 my $copy = $near->{reference};
  53 warn $copy;
  54 warn Scalar::Util::isweak($near->{reference});
  55 warn $near->{reference};
  56 warn $near->{reference};
  57 undef($near);
  58 warn "Done\n";