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
  13     # optimization: it's really slow to go through new_object for every access
  14     # so return the singleton if we see it already exists, which it will every
  15     # single except the first.
  16     no strict 'refs';
  17     return ${"$instance\::singleton"} if defined ${"$instance\::singleton"};
  18
  19     # We need to go through ->new in order to make sure BUILD and
  20     # BUILDARGS get called.
  21     return $instance->meta->name->new;
  22 }
  23
  24 sub clone_instance {
  25     my ($self, $instance) = @_;
  26     $self->get_singleton_instance($instance);
  27 }
  28
  29 sub get_slot_value {
  30     my ($self, $instance, $slot_name) = @_;
  31     $self->is_slot_initialized($instance, $slot_name) ? $self->get_singleton_instance($instance)->{$slot_name} : undef;
  32 }
  33
  34 sub set_slot_value {
  35     my ($self, $instance, $slot_name, $value) = @_;
  36     $self->get_singleton_instance($instance)->{$slot_name} = $value;
  37 }
  38
  39 sub deinitialize_slot {
  40     my ( $self, $instance, $slot_name ) = @_;
  41     delete $self->get_singleton_instance($instance)->{$slot_name};
  42 }
  43
  44 sub is_slot_initialized {
  45     my ($self, $instance, $slot_name, $value) = @_;
  46     exists $self->get_singleton_instance($instance)->{$slot_name} ? 1 : 0;
  47 }
  48
  49 sub weaken_slot_value {
  50     my ($self, $instance, $slot_name) = @_;
  51     weaken $self->get_singleton_instance($instance)->{$slot_name};
  52 }
  53
  54 sub inline_slot_access {
  55     my ($self, $instance, $slot_name) = @_;
  56     sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}", $instance, $instance, $slot_name;
  57 }
  58
  59 no Moose;
  60
  61 1;
  62
  63 __END__
  64
  65 =pod
  66
  67 =head1 NAME
  68
  69 MooseX::Singleton::Meta::Instance
  70
  71 =head1 DESCRIPTION
  72
  73 This instance metaclass manages attribute access and storage. When accessing an
  74 attribute, it will convert a bare package to its cached singleton instance
  75 (creating it if necessary).
  76
  77 =cut
  78