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 our $VERSION = '0.25';
   7 $VERSION = eval $VERSION;
   8
   9 sub existing_singleton {
  10     my ($class) = @_;
  11     my $pkg = $class->name;
  12
  13     no strict 'refs';
  14
  15     # create exactly one instance
  16     if ( defined ${"$pkg\::singleton"} ) {
  17         return ${"$pkg\::singleton"};
  18     }
  19
  20     return;
  21 }
  22
  23 sub clear_singleton {
  24     my ($class) = @_;
  25     my $pkg = $class->name;
  26     no strict 'refs';
  27     undef ${"$pkg\::singleton"};
  28 }
  29
  30 override _construct_instance => sub {
  31     my ($class) = @_;
  32
  33     # create exactly one instance
  34     my $existing = $class->existing_singleton;
  35     return $existing if $existing;
  36
  37     my $pkg = $class->name;
  38     no strict 'refs';
  39     return ${"$pkg\::singleton"} = super;
  40 };
  41
  42 if ( $Moose::VERSION >= 1.9900 ) {
  43     override _inline_params => sub {
  44         my $self = shift;
  45
  46         return
  47             'my $existing = do {',
  48                 'no strict "refs";',
  49                 'no warnings "once";',
  50                 '\${"$class\::singleton"};',
  51             '};',
  52             'return ${$existing} if ${$existing};',
  53             super();
  54     };
  55
  56     override _inline_extra_init => sub {
  57         my $self = shift;
  58
  59         return '${$existing} = $instance;';
  60     };
  61 }
  62
  63 no Moose::Role;
  64
  65 1;
  66
  67 __END__
  68
  69 =pod
  70
  71 =head1 NAME
  72
  73 MooseX::Singleton::Role::Meta::Class - Metaclass role for MooseX::Singleton
  74
  75 =head1 DESCRIPTION
  76
  77 This metaclass role makes sure that there is only ever one instance of an
  78 object for a singleton class. The first call to C<construct_instance> is run
  79 normally (and then cached). Subsequent calls will return the cached version.
  80
  81 =cut
  82