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