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 | |
03e1b8df |
31 | sub _clear_instance { |
32 | my ($class) = @_; |
33 | $class->meta->clear_singleton; |
34 | } |
35 | |
2b4ce4bd |
36 | no Moose; |
37 | |
109b110b |
38 | 1; |
39 | |
b375b147 |
40 | __END__ |
41 | |
42 | =pod |
43 | |
44 | =head1 NAME |
45 | |
46 | MooseX::Singleton::Object - base class for MooseX::Singleton |
47 | |
48 | =head1 DESCRIPTION |
49 | |
50 | This just adds C<instance> as a shortcut for C<new>. |
51 | |
52 | =cut |
53 | |