Singleton Roles in Moose

I am attempting to write a singleton role using Perl and Moose. I understand a MooseX::Singleton module is available but there is always resistance when requiring another CPAN module for our project. After trying this and having a little trouble I would like to understand WHY my method is not working. The singleton role I have written is as follows:

package Singleton;
use Moose::Role;

my $_singleInstance;

around 'new' => sub {
    my $orig = shift;
    my $class = shift;
    if (not defined $_singleInstance ){
        $_singleInstance = $class->$orig(@_);
    }
    return $_singleInstance;
};

sub getInstance
{
    return __PACKAGE__->new();
}

1;

This appears to work find when only one class uses the singleton role. However when two classes (ClassA a开发者_运维百科nd ClassB for example) both consume the Singleton role it appears as they are both referring to a shared $_singleInstance variable. If I call ClassA->getInstance it returns a reference to a ClassA object. If I call ClassB->getInstance sometime later in the same script it returns a reference to an object of type ClassA (even though I clearly called the getInstance method for ClassB). If I dont use a role and actually copy and paste the code from the Singleton role into ClassA and ClassB it appears to work fine. Whats going on here?

---

You're saving the instance across all types, rather than using a different one for each class type.

This calls for the Factory design pattern, e.g.:

package MyApp::Factory;

my %instances;

# intantiates an object instance if there is none available,
# otherwise returns an existing one.
sub instance
{
    my ($class, $type, @options) = @_;

    return $instances{$type} if $instances{$type};
    $instances{$type} = $type->new(@options);
}

If you really want singletons, please install MooseX::Singleton rather than rolling your own -- if you look at the source you'll see it accounts for a lot of edge cases. However, I would advise against forcing your classes to be singletons, as that removes control away from the class itself. Instead, use a factory (as above), so the caller can decide how to construct the class, rather than forcing all consumers into one usecase.

---

Your $_singleInstance is lexically scoped to the block where it appears, in this case your whole Singleton package. Your around modifier forms a closure over this variable, meaning it sees the same $_singleInstance every time it is run, regardless of what class it gets composed into.

A simple way to solve this would be to store your singletons in a hash:

my %_instances;

around 'new' => sub {
    my $orig = shift;
    my $class = shift;
    if (not defined $_instances{$class} ){
        $_instances{$class} = $class->$orig(@_);
    }
    return $_instances{$class};
};

Possibly a better way would be to set up a custom metaclass role that stores the singleton instance for each class that consumes that role.

---

"I understand a MooseX::Singleton module is available but there is always resistance when requiring another CPAN module for our project. "

This is really something that needs to be addressed. As a dep, MX:Singleton is very small. What is the issue? Are you stuck on a globally shared Perl on a shared server or similar? If so, you really should look at local::lib, which is designed to make it easy for individual developers to manage CPAN dependencies properly with a Makefile.PL script, just like any other CPAN module.

---

They are sharing the instance variable. You need to allocate it inside the package using the role.

# find storage for instance
my $iref = \${ "${class}::_instance" };

# an instance already exists; return it instead of creating a new one
return $$iref if defined $$iref;

# no instance yet, create a new one
...