changes to work with Moose 0.73_01+
[gitmo/MooseX-Singleton.git] / lib / MooseX / Singleton / Meta / Class.pm
CommitLineData
109b110b 1#!/usr/bin/env perl
2package MooseX::Singleton::Meta::Class;
3use Moose;
4use MooseX::Singleton::Meta::Instance;
0cd38a85 5use MooseX::Singleton::Meta::Method::Constructor;
109b110b 6
7extends 'Moose::Meta::Class';
8
9sub initialize {
10 my $class = shift;
11 my $pkg = shift;
12
0cd38a85 13 my $self = $class->SUPER::initialize(
109b110b 14 $pkg,
15 instance_metaclass => 'MooseX::Singleton::Meta::Instance',
0cd38a85 16 constructor_class => 'MooseX::Singleton::Meta::Method::Constructor',
109b110b 17 @_,
18 );
0cd38a85 19
20 return $self;
21}
109b110b 22
1de95613 23sub existing_singleton {
3822ace2 24 my ($class) = @_;
25 my $pkg = $class->name;
26
27 no strict 'refs';
28
29 # create exactly one instance
1de95613 30 if (defined ${"$pkg\::singleton"}) {
31 return ${"$pkg\::singleton"};
3822ace2 32 }
33
1de95613 34 return;
35}
36
0cd38a85 37override _construct_instance => sub {
1de95613 38 my ($class) = @_;
39
40 # create exactly one instance
41 my $existing = $class->existing_singleton;
42 return $existing if $existing;
43
44 my $pkg = $class->name;
45 no strict 'refs';
46 return ${"$pkg\::singleton"} = super;
3822ace2 47};
48
2b4ce4bd 49no Moose;
50
109b110b 511;
52
b375b147 53__END__
54
55=pod
56
57=head1 NAME
58
59MooseX::Singleton::Meta::Class
60
61=head1 DESCRIPTION
62
63This metaclass is where the forcing of one instance occurs. The first call to
64C<construct_instance> is run normally (and then cached). Subsequent calls will
65return the cached version.
66
67=cut
68