lib/MooseX/InsideOut/Role/Meta/Instance.pm

   1 package MooseX::InsideOut::Role::Meta::Instance;
   2
   3 use Moose::Role;
   4
   5 use Hash::Util::FieldHash::Compat qw(fieldhash);
   6 use Scalar::Util qw(refaddr weaken);
   7 use namespace::clean -except => 'meta';
   8
   9 fieldhash our %attr;
  10
  11 around create_instance => sub {
  12   my $next = shift;
  13   my $instance = shift->$next(@_);
  14   $attr{refaddr $instance} = {};
  15   return $instance;
  16 };
  17
  18 sub get_slot_value {
  19   my ($self, $instance, $slot_name) = @_;
  20
  21   return $attr{refaddr $instance}->{$slot_name};
  22 }
  23
  24 sub set_slot_value {
  25   my ($self, $instance, $slot_name, $value) = @_;
  26
  27   return $attr{refaddr $instance}->{$slot_name} = $value;
  28 }
  29
  30 sub deinitialize_slot {
  31   my ($self, $instance, $slot_name) = @_;
  32   return delete $attr{refaddr $instance}->{$slot_name};
  33 }
  34
  35 sub deinitialize_all_slots {
  36   my ($self, $instance) = @_;
  37   $attr{refaddr $instance} = {};
  38 }
  39
  40 sub is_slot_initialized {
  41   my ($self, $instance, $slot_name) = @_;
  42
  43   return exists $attr{refaddr $instance}->{$slot_name};
  44 }
  45
  46 sub weaken_slot_value {
  47   my ($self, $instance, $slot_name) = @_;
  48   weaken $attr{refaddr $instance}->{$slot_name};
  49 }
  50
  51 around inline_create_instance => sub {
  52   my $next = shift;
  53   my ($self, $class_variable) = @_;
  54   my $code = $self->$next($class_variable);
  55   $code = "do { {my \$instance = ($code);";
  56   $code .= sprintf(
  57     '$%s::attr{Scalar::Util::refaddr($instance)} = {};',
  58     __PACKAGE__,
  59   );
  60   $code .= '$instance }';
  61   return $code;
  62 };
  63
  64 sub inline_slot_access {
  65   my ($self, $instance, $slot_name) = @_;
  66   return sprintf '$%s::attr{Scalar::Util::refaddr(%s)}->{%s}',
  67     __PACKAGE__, $instance, $slot_name;
  68 }
  69
  70 1;
  71
  72 __END__
  73
  74 =head1 DESCRIPTION
  75
  76 Meta-instance role implementing inside-out storage.
  77
  78 =method create_instance
  79
  80 =method get_slot_value
  81
  82 =method set_slot_value
  83
  84 =method deinitialize_slot
  85
  86 =method deinitialize_all_slots
  87
  88 =method is_slot_initialized
  89
  90 =method weaken_slot_value
  91
  92 =method inline_create_instance
  93
  94 =method inline_slot_access
  95
  96 See L<Class::MOP::Instance>.
  97
  98 =cut