X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Singleton.git;a=blobdiff_plain;f=lib%2FMooseX%2FSingleton%2FRole%2FMeta%2FInstance.pm;fp=lib%2FMooseX%2FSingleton%2FMeta%2FInstance.pm;h=b13b0cad5fff8fa58247a172eb22589c1eb0004c;hp=a56db58fe8ac0dac747308d2117815b741760a34;hb=8eec3c69ee4aa161601b0255c3b32cd6d9cc6998;hpb=b1882d9b6ec47b18a97dadb6e1326305d890c806 diff --git a/lib/MooseX/Singleton/Meta/Instance.pm b/lib/MooseX/Singleton/Role/Meta/Instance.pm similarity index 74% rename from lib/MooseX/Singleton/Meta/Instance.pm rename to lib/MooseX/Singleton/Role/Meta/Instance.pm index a56db58..b13b0ca 100644 --- a/lib/MooseX/Singleton/Meta/Instance.pm +++ b/lib/MooseX/Singleton/Role/Meta/Instance.pm @@ -1,10 +1,8 @@ #!/usr/bin/env perl -package MooseX::Singleton::Meta::Instance; -use Moose; +package MooseX::Singleton::Role::Meta::Instance; +use Moose::Role; use Scalar::Util 'weaken'; -extends 'Moose::Meta::Instance'; - sub get_singleton_instance { my ($self, $instance) = @_; @@ -21,40 +19,40 @@ sub get_singleton_instance { return $instance->meta->name->new; } -sub clone_instance { +override clone_instance => sub { my ($self, $instance) = @_; $self->get_singleton_instance($instance); -} +}; -sub get_slot_value { +override get_slot_value => sub { my ($self, $instance, $slot_name) = @_; $self->is_slot_initialized($instance, $slot_name) ? $self->get_singleton_instance($instance)->{$slot_name} : undef; -} +}; -sub set_slot_value { +override set_slot_value => sub { my ($self, $instance, $slot_name, $value) = @_; $self->get_singleton_instance($instance)->{$slot_name} = $value; -} +}; -sub deinitialize_slot { +override deinitialize_slot => sub { my ( $self, $instance, $slot_name ) = @_; delete $self->get_singleton_instance($instance)->{$slot_name}; -} +}; -sub is_slot_initialized { +override is_slot_initialized => sub { my ($self, $instance, $slot_name, $value) = @_; exists $self->get_singleton_instance($instance)->{$slot_name} ? 1 : 0; -} +}; -sub weaken_slot_value { +override weaken_slot_value => sub { my ($self, $instance, $slot_name) = @_; weaken $self->get_singleton_instance($instance)->{$slot_name}; -} +}; -sub inline_slot_access { +override inline_slot_access => sub { my ($self, $instance, $slot_name) = @_; sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}", $instance, $instance, $slot_name; -} +}; no Moose; @@ -66,13 +64,12 @@ __END__ =head1 NAME -MooseX::Singleton::Meta::Instance +MooseX::Singleton::Role::Meta::Instance - Instance metaclass role for MooseX::Singleton =head1 DESCRIPTION -This instance metaclass manages attribute access and storage. When accessing an -attribute, it will convert a bare package to its cached singleton instance -(creating it if necessary). +This role overrides all object access so that it gets the appropriate +singleton instance for the class. =cut