Converted this extension to use MetaRole

[gitmo/MooseX-Singleton.git] / lib / MooseX / Singleton / Role / Meta / Class.pm

diff --git a/lib/MooseX/Singleton/Role/Meta/Class.pm b/lib/MooseX/Singleton/Role/Meta/Class.pm
new file mode 100644 (file)
index 0000000..a8a43ee
--- /dev/null
+++ b/lib/MooseX/Singleton/Role/Meta/Class.pm
@@ -0,0 +1,59 @@
+#!/usr/bin/env perl
+package MooseX::Singleton::Role::Meta::Class;
+use Moose::Role;
+use MooseX::Singleton::Meta::Instance;
+use MooseX::Singleton::Meta::Method::Constructor;
+
+sub existing_singleton {
+    my ($class) = @_;
+    my $pkg = $class->name;
+
+    no strict 'refs';
+
+    # create exactly one instance
+    if (defined ${"$pkg\::singleton"}) {
+        return ${"$pkg\::singleton"};
+    }
+
+    return;
+}
+
+sub clear_singleton {
+    my ($class) = @_;
+    my $pkg = $class->name;
+    no strict 'refs';
+    undef ${"$pkg\::singleton"};
+}
+
+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::Role::Meta::Class - Metaclass role for MooseX::Singleton
+
+=head1 DESCRIPTION
+
+This metaclass role makes sure that there is only ever one instance of an
+object for a singleton class. The first call to C<construct_instance> is run
+normally (and then cached). Subsequent calls will return the cached version.
+
+=cut
+