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