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