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

Question

I wrote a simple Moose class called Document . This class has two attributes: name and homepage .

The class should also provide a method called do_something() that retrieves and returns text from various sources (such as a website or different databases) based on the homepage attribute.

Since there will be many completely different implementations for do_something() , I would like to have them in different packages / classes, and each of these classes should know whether it is responsible for the homepage attribute or if it is not.

My approach so far includes 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 the default for do_something() and common methods (for example, an 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 that define their responsibility using the responsible() method:

 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 is as follows:

 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); } 

Now it 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 result:

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

But there are at least two problems with this code:

• I need to keep a list of all known implementations in _build_fetcher . I would prefer the code to automatically select from each loaded module / class under the Document::Fetcher:: . Or maybe there is a better way to “register” such plugins?

• At the moment, all the code looks too bloated. I am sure that people have already written such a system of plugins. Is there something in MooseX that provides the desired behavior?

Answer 1

What you are looking for is Factory , in particular Abstract Factory . The constructor for your Factory class will 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 will go into Document::Fetcher::Factory->new . This separates the recipients from your documents. Instead of a document that knows how to determine which Fetcher implementation it needs, Fetchers can do it themselves.

Your basic Fetcher role template that can tell Factory if it can handle it is good if your priority is to let people add new Fetchers without changing Factory. On the other hand, Fetcher :: Factory cannot know that several Fetchers may be valid for a given URL and that they may be better than others.

To avoid a large list of Fetcher implementations hardcoded in your Fetcher :: Factory, each Fetcher boot register with Fetcher :: Factory at boot time.

 my %Registered_Classes; sub register_class { my $class = shift; my $registeree = shift; $Registered_Classes{$registeree}++; return; } sub registered_classes { return \%Registered_Classes; } 

You may have something, perhaps a Document, preload a bunch of regular Fetchers if you want your pie to eat it too.