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

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