bump version
[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
2c50d2cd 5our $VERSION = '0.24';
5a0f3fa6 6$VERSION = eval $VERSION;
7
7afceec3 8sub get_singleton_instance {
4c256923 9 my ( $self, $instance ) = @_;
109b110b 10
11 return $instance if blessed $instance;
ef266b1f 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
e2119ce9 19 # We need to go through ->new in order to make sure BUILD and
20 # BUILDARGS get called.
21 return $instance->meta->name->new;
109b110b 22}
23
4c256923 24override clone_instance => sub {
25 my ( $self, $instance ) = @_;
7afceec3 26 $self->get_singleton_instance($instance);
8eec3c69 27};
7afceec3 28
4c256923 29override get_slot_value => sub {
30 my ( $self, $instance, $slot_name ) = @_;
31 $self->is_slot_initialized( $instance, $slot_name )
32 ? $self->get_singleton_instance($instance)->{$slot_name}
33 : undef;
8eec3c69 34};
109b110b 35
4c256923 36override set_slot_value => sub {
37 my ( $self, $instance, $slot_name, $value ) = @_;
7afceec3 38 $self->get_singleton_instance($instance)->{$slot_name} = $value;
8eec3c69 39};
109b110b 40
4c256923 41override deinitialize_slot => sub {
109b110b 42 my ( $self, $instance, $slot_name ) = @_;
7afceec3 43 delete $self->get_singleton_instance($instance)->{$slot_name};
8eec3c69 44};
109b110b 45
4c256923 46override is_slot_initialized => sub {
47 my ( $self, $instance, $slot_name, $value ) = @_;
7afceec3 48 exists $self->get_singleton_instance($instance)->{$slot_name} ? 1 : 0;
8eec3c69 49};
109b110b 50
4c256923 51override weaken_slot_value => sub {
52 my ( $self, $instance, $slot_name ) = @_;
7afceec3 53 weaken $self->get_singleton_instance($instance)->{$slot_name};
8eec3c69 54};
109b110b 55
4c256923 56override inline_slot_access => sub {
57 my ( $self, $instance, $slot_name ) = @_;
58 sprintf "%s->meta->instance_metaclass->get_singleton_instance(%s)->{%s}",
59 $instance, $instance, $slot_name;
8eec3c69 60};
109b110b 61
2cb90d53 62no Moose::Role;
2b4ce4bd 63
109b110b 641;
65
b375b147 66__END__
67
68=pod
69
70=head1 NAME
71
8eec3c69 72MooseX::Singleton::Role::Meta::Instance - Instance metaclass role for MooseX::Singleton
b375b147 73
74=head1 DESCRIPTION
75
8eec3c69 76This role overrides all object access so that it gets the appropriate
77singleton instance for the class.
b375b147 78
79=cut
80