lib/MooseX/Singleton/Meta/Instance.pm

   1 #!/usr/bin/env perl
   2 package MooseX::Singleton::Meta::Instance;
   3 use Moose;
   4 use Scalar::Util 'weaken';
   5
   6 extends 'Moose::Meta::Instance';
   7
   8 sub get_singleton_instance {
   9     my ($self, $instance) = @_;
  10
  11     return $instance if blessed $instance;
  12     return $instance->instance;
  13 }
  14
  15 sub clone_instance {
  16     my ($self, $instance) = @_;
  17     $self->get_singleton_instance($instance);
  18 }
  19
  20 sub get_slot_value {
  21     my ($self, $instance, $slot_name) = @_;
  22     $self->is_slot_initialized($instance, $slot_name) ? $self->get_singleton_instance($instance)->{$slot_name} : undef;
  23 }
  24
  25 sub set_slot_value {
  26     my ($self, $instance, $slot_name, $value) = @_;
  27     $self->get_singleton_instance($instance)->{$slot_name} = $value;
  28 }
  29
  30 sub deinitialize_slot {
  31     my ( $self, $instance, $slot_name ) = @_;
  32     delete $self->get_singleton_instance($instance)->{$slot_name};
  33 }
  34
  35 sub is_slot_initialized {
  36     my ($self, $instance, $slot_name, $value) = @_;
  37     exists $self->get_singleton_instance($instance)->{$slot_name} ? 1 : 0;
  38 }
  39
  40 sub weaken_slot_value {
  41     my ($self, $instance, $slot_name) = @_;
  42     weaken $self->get_singleton_instance($instance)->{$slot_name};
  43 }
  44
  45 sub inline_slot_access {
  46     my ($self, $instance, $slot_name) = @_;
  47     sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}", $instance, $instance, $slot_name;
  48 }
  49
  50 1;
  51