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 | ||
21e80909 | 13 | return $class->new(@args); |
d928ce3a | 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 |