X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FSingleton%2FMeta%2FClass.pm;h=529095b8da952a8ec6aff9e973ad3e53b622d66f;hb=0cd38a85e3f9a77914e846ad84e290b22b501b5a;hp=447859d5fe8796cbcbd6af37454e34dfd6dd9352;hpb=109b110b1d5969c8ae2ec7a5e5d86066f895d828;p=gitmo%2FMooseX-Singleton.git

diff --git a/lib/MooseX/Singleton/Meta/Class.pm b/lib/MooseX/Singleton/Meta/Class.pm
index 447859d..529095b 100644
--- a/lib/MooseX/Singleton/Meta/Class.pm
+++ b/lib/MooseX/Singleton/Meta/Class.pm
@@ -2,6 +2,7 @@
 package MooseX::Singleton::Meta::Class;
 use Moose;
 use MooseX::Singleton::Meta::Instance;
+use MooseX::Singleton::Meta::Method::Constructor;
 
 extends 'Moose::Meta::Class';
 
@@ -9,12 +10,59 @@ sub initialize {
     my $class = shift;
     my $pkg   = shift;
 
-    $class->SUPER::initialize(
+    my $self = $class->SUPER::initialize(
         $pkg,
         instance_metaclass => 'MooseX::Singleton::Meta::Instance',
+        constructor_class  => 'MooseX::Singleton::Meta::Method::Constructor',
         @_,
     );
+
+    return $self;
+}
+
+sub existing_singleton {
+    my ($class) = @_;
+    my $pkg = $class->name;
+
+    no strict 'refs';
+
+    # create exactly one instance
+    if (defined ${"$pkg\::singleton"}) {
+        return ${"$pkg\::singleton"};
+    }
+
+    return;
+}
+
+override _construct_instance => sub {
+    my ($class) = @_;
+
+    # create exactly one instance
+    my $existing = $class->existing_singleton;
+    return $existing if $existing;
+
+    my $pkg = $class->name;
+    no strict 'refs';
+    return ${"$pkg\::singleton"} = super;
 };
 
+no Moose;
+
 1;
 
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Singleton::Meta::Class
+
+=head1 DESCRIPTION
+
+This metaclass is where the forcing of one instance occurs. The first call to
+C<construct_instance> is run normally (and then cached). Subsequent calls will
+return the cached version.
+
+=cut
+