Perl / Moose - How can I dynamically choose a specific implementation of a method?

Question

I've written a simple Moose based class called Document. This class has two attributes: name and homepage.

The class also needs to provide a method called do_something() which retrieves and returns text from different sources (like a website or different databases) based on the homepage attribute.

Since there will be a lot of totally different implementations for do_something(), I'd like to have them in different packages/classes and each of these classes should know if it is responsible for the homepage attribute or if it isn't.

My approach so far involves two roles:

package Role::Fetcher;
use Moose::Role;
requires 'do_something';
has url => (
    is => 'ro',
    isa => 'Str'
);

package Role::Implementation;
use Moose::Role;
with 'Role::Fetcher';
requires 'responsible';

A class called Document::Fetcher which provides a default implmenentation for do_something() and commonly used methods (like a HTTP GET request):

package Document::Fetcher;
use Moose;
use LWP::UserAgent;
with 'Role::Fetcher';

has ua => (
    is => 'ro',
    isa => 'Object',
    required => 1,
    default => sub { LWP::UserAgent->new }
);

sub do_something {'called from default implementation'}
sub get {
    my $r = shift->ua->get(shift);
    return $r->content if $r->is_success;
    # ...
}

And specific implementations which determine their responsibility via a method called responsible():

package Document::Fetcher::ImplA;
use Moose;
extends 'Document::Fetcher';
with 'Role::Implementation';

sub do_something {'called from implementation A'}
sub responsible { return 1 if shift->url =~ m#foo#; }

package Document::Fetcher::ImplB;
use Moose;
extends 'Document::Fetcher';
with 'Role::Implementation';

sub do_something {'called from implementation B'}
sub responsible { return 1 if shift->url =~ m#bar#; }

My Document class looks like this:

package Document;
use Moose;

has [qw/name homepage/] => (
    is => 'rw',
    isa => 'Str'
);

has fetcher => (
    is => 'ro',
    isa => 'Document::Fetcher',
    required => 1,
    lazy => 1,
    builder => '_build_fetcher',
    handles => [qw/do_something/]
);

sub _build_fetcher {
    my $self = shift;
    my @implementations = qw/ImplA ImplB/;

    foreach my $i (@implementations) {
        my $fetcher = "Document::Fetcher::$i"->new(url => $self->homepage);
        return $fetcher if $fetcher->responsible();
    }

    return Document::Fetcher->new(url => $self->homepage);
}

Right now this works as it should. If I call the following code:

foreach my $i (qw/foo bar baz/) {
    my $doc = Document->new(name => $i, homepage => "http://$i.tld/");
    say $doc->name . ": " . $doc->do_something;
}

I get the expected output:

foo: called from implementation A
bar: called from implementation B
baz: called from default implementation

But there are at least two issues with this code:

1. I need to keep a list of all known implementations in _build_fetcher. I'd prefer a way where the code would automatically choose from every loaded module/class beneath the namespace Document::Fetcher::. Or maybe there's a better way to "register" these kind of plugins?

2. At the moment the whole code looks a bit too bloated. I am sure people have written this kind of plugin system before. Isn't there something in MooseX which provides the desired behaviour?

Answer 1

What you're looking for is a Factory, specifically an Abstract Factory. The constructor for your Factory class would determine which implementation to return based on its arguments.

# Returns Document::Fetcher::ImplA or Document::Fetcher::ImplB or ...
my $fetcher = Document::Fetcher::Factory->new( url => $url );

The logic in _build_fetcher would go into Document::Fetcher::Factory->new. This separates the Fetchers from your Documents. Instead of Document knowing how to figure out which Fetcher implementation it needs, Fetchers can do that themselves.

Your basic pattern of having the Fetcher role able to inform the Factory if its able to deal with it is good if your priority is to allow people to add new Fetchers without having to alter the Factory. On the down side, the Fetcher::Factory cannot know that multiple Fetchers might be valid for a given URL and that one might be better than the other.

To avoid having a big list of Fetcher implementations hard coded in your Fetcher::Factory, have each Fetcher role register itself with the Fetcher::Factory when its loaded.

my %Registered_Classes;

sub register_class {
    my $class = shift;
    my $registeree = shift;

    $Registered_Classes{$registeree}++;

    return;
}

sub registered_classes {
    return \%Registered_Classes;
}

You can have something, probably Document, pre-load a bunch of common Fetchers if you want your cake and eat it too.