Singleton Roles in Moose

Question

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 and 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?

Answer 1

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.

Answer 2

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.