Commit | Line | Data |
8eec3c69 |
1 | package MooseX::Singleton::Role::Meta::Instance; |
2 | use Moose::Role; |
109b110b |
3 | use Scalar::Util 'weaken'; |
4 | |
724efd93 |
5 | our $VERSION = '0.22'; |
5a0f3fa6 |
6 | $VERSION = eval $VERSION; |
7 | |
7afceec3 |
8 | sub 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 |
24 | override clone_instance => sub { |
25 | my ( $self, $instance ) = @_; |
7afceec3 |
26 | $self->get_singleton_instance($instance); |
8eec3c69 |
27 | }; |
7afceec3 |
28 | |
4c256923 |
29 | override 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 |
36 | override 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 |
41 | override 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 |
46 | override 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 |
51 | override 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 |
56 | override 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 |
62 | no Moose::Role; |
2b4ce4bd |
63 | |
109b110b |
64 | 1; |
65 | |
b375b147 |
66 | __END__ |
67 | |
68 | =pod |
69 | |
70 | =head1 NAME |
71 | |
8eec3c69 |
72 | MooseX::Singleton::Role::Meta::Instance - Instance metaclass role for MooseX::Singleton |
b375b147 |
73 | |
74 | =head1 DESCRIPTION |
75 | |
8eec3c69 |
76 | This role overrides all object access so that it gets the appropriate |
77 | singleton instance for the class. |
b375b147 |
78 | |
79 | =cut |
80 | |