Commit | Line | Data |
109b110b |
1 | #!/usr/bin/env perl |
8eec3c69 |
2 | package MooseX::Singleton::Role::Object; |
3 | use Moose::Role; |
109b110b |
4 | |
109b110b |
5 | sub instance { shift->new } |
6 | |
d928ce3a |
7 | sub initialize { |
8 | my ($class, @args) = @_; |
9 | |
10 | my $existing = $class->meta->existing_singleton; |
11 | confess "Singleton is already initialized" if $existing; |
12 | |
13 | return $class->SUPER::new(@args); |
14 | } |
15 | |
8eec3c69 |
16 | override new => sub { |
1de95613 |
17 | my ($class, @args) = @_; |
18 | |
19 | my $existing = $class->meta->existing_singleton; |
20 | confess "Singleton is already initialized" if $existing and @args; |
21 | |
963b26bd |
22 | # Otherwise BUILD will be called repeatedly on the existing instance. |
23 | # -- rjbs, 2008-02-03 |
24 | return $existing if $existing and ! @args; |
25 | |
8eec3c69 |
26 | return super(); |
27 | }; |
1de95613 |
28 | |
03e1b8df |
29 | sub _clear_instance { |
30 | my ($class) = @_; |
31 | $class->meta->clear_singleton; |
32 | } |
33 | |
2b4ce4bd |
34 | no Moose; |
35 | |
109b110b |
36 | 1; |
37 | |
b375b147 |
38 | __END__ |
39 | |
40 | =pod |
41 | |
42 | =head1 NAME |
43 | |
8eec3c69 |
44 | MooseX::Singleton::Object - Object class role for MooseX::Singleton |
b375b147 |
45 | |
46 | =head1 DESCRIPTION |
47 | |
48 | This just adds C<instance> as a shortcut for C<new>. |
49 | |
50 | =cut |
51 | |