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
   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 if ( $Moose::VERSION >= 1.9900 ) {
  41     override _inline_params => sub {
  42         my $self = shift;
  43
  44         return
  45             'my $existing = do {',
  46                 'no strict "refs";',
  47                 'no warnings "once";',
  48                 '\${"$class\::singleton"};',
  49             '};',
  50             'return ${$existing} if ${$existing};',
  51             super();
  52     };
  53
  54     override _inline_extra_init => sub {
  55         my $self = shift;
  56
  57         return '${$existing} = $instance;';
  58     };
  59 }
  60
  61 no Moose::Role;
  62
  63 1;
  64
  65 # ABSTRACT: Metaclass role for MooseX::Singleton
  66
  67 __END__
  68
  69 =pod
  70
  71 =head1 DESCRIPTION
  72
  73 This metaclass role makes sure that there is only ever one instance of an
  74 object for a singleton class. The first call to C<construct_instance> is run
  75 normally (and then cached). Subsequent calls will return the cached version.
  76
  77 =cut
  78