lib/MooseX/Singleton/Role/Meta/Class.pm

   1 package MooseX::Singleton::Role::Meta::Class;
   2 use Moose::Role;
   3 use MooseX::Singleton::Role::Meta::Instance;
   4 use MooseX::Singleton::Role::Meta::Method::Constructor;
   5
   6 sub existing_singleton {
   7     my ($class) = @_;
   8     my $pkg = $class->name;
   9
  10     no strict 'refs';
  11
  12     # create exactly one instance
  13     if (defined ${"$pkg\::singleton"}) {
  14         return ${"$pkg\::singleton"};
  15     }
  16
  17     return;
  18 }
  19
  20 sub clear_singleton {
  21     my ($class) = @_;
  22     my $pkg = $class->name;
  23     no strict 'refs';
  24     undef ${"$pkg\::singleton"};
  25 }
  26
  27 override _construct_instance => sub {
  28     my ($class) = @_;
  29
  30     # create exactly one instance
  31     my $existing = $class->existing_singleton;
  32     return $existing if $existing;
  33
  34     my $pkg = $class->name;
  35     no strict 'refs';
  36     return ${"$pkg\::singleton"} = super;
  37 };
  38
  39 no Moose;
  40
  41 1;
  42
  43 __END__
  44
  45 =pod
  46
  47 =head1 NAME
  48
  49 MooseX::Singleton::Role::Meta::Class - Metaclass role for MooseX::Singleton
  50
  51 =head1 DESCRIPTION
  52
  53 This metaclass role makes sure that there is only ever one instance of an
  54 object for a singleton class. The first call to C<construct_instance> is run
  55 normally (and then cached). Subsequent calls will return the cached version.
  56
  57 =cut
  58