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

   1 package MooseX::Singleton::Role::Meta::Instance;
   2 use Moose::Role;
   3 use Scalar::Util 'weaken';
   4
   5
   6 sub get_singleton_instance {
   7     my ( $self, $instance ) = @_;
   8
   9     return $instance if blessed $instance;
  10
  11     # optimization: it's really slow to go through new_object for every access
  12     # so return the singleton if we see it already exists, which it will every
  13     # single except the first.
  14     no strict 'refs';
  15     return ${"$instance\::singleton"} if defined ${"$instance\::singleton"};
  16
  17     # We need to go through ->new in order to make sure BUILD and
  18     # BUILDARGS get called.
  19     return $instance->meta->name->new;
  20 }
  21
  22 override clone_instance => sub {
  23     my ( $self, $instance ) = @_;
  24     $self->get_singleton_instance($instance);
  25 };
  26
  27 override get_slot_value => sub {
  28     my ( $self, $instance, $slot_name ) = @_;
  29     $self->is_slot_initialized( $instance, $slot_name )
  30         ? $self->get_singleton_instance($instance)->{$slot_name}
  31         : undef;
  32 };
  33
  34 override set_slot_value => sub {
  35     my ( $self, $instance, $slot_name, $value ) = @_;
  36     $self->get_singleton_instance($instance)->{$slot_name} = $value;
  37 };
  38
  39 override deinitialize_slot => sub {
  40     my ( $self, $instance, $slot_name ) = @_;
  41     delete $self->get_singleton_instance($instance)->{$slot_name};
  42 };
  43
  44 override is_slot_initialized => sub {
  45     my ( $self, $instance, $slot_name, $value ) = @_;
  46     exists $self->get_singleton_instance($instance)->{$slot_name} ? 1 : 0;
  47 };
  48
  49 override weaken_slot_value => sub {
  50     my ( $self, $instance, $slot_name ) = @_;
  51     weaken $self->get_singleton_instance($instance)->{$slot_name};
  52 };
  53
  54 override inline_slot_access => sub {
  55     my ( $self, $instance, $slot_name ) = @_;
  56     sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}",
  57         $instance, $instance, $slot_name;
  58 };
  59
  60 no Moose::Role;
  61
  62 1;
  63
  64 # ABSTRACT: Instance metaclass role for MooseX::Singleton
  65
  66 __END__
  67
  68 =pod
  69
  70 =head1 DESCRIPTION
  71
  72 This role overrides all object access so that it gets the appropriate
  73 singleton instance for the class.
  74
  75 =cut
  76