How can I code a factory in Perl and Moose?

Question

Is there a simpler or better (=>easier to maintain) way to use Perl and Moose to instantiate classes based on incoming data?

The following code is a stripped down sample from a project I'm working on.

package FooBar;
use Moose;
has 'SUBCLASS' =>('isa'=>'Str',required=>'1',is=>'ro');
has 'MSG' =>('isa'=>'Str',required=>'1',is=>'ro');

sub BUILD {
      my $self = shift;
      my ($a)=@_;
      bless($self,$a->{SUBCLASS})
}
sub Hi {
   my $self=shift;
   print "Hi, I'm a " . ref($self)  ." and I say [". $self->MSG()."]\n";
}

package Foo;
use Moose;
extends ("FooBar");

package Bar;
use Moose;
extends ("FooBar");

package main;
use strict;
use warnings;

for my $line (<DATA>) {
   my ($case,$msg)=split(/[\n\r,]\s*/,$line);
   FooBar->new(SUBCLASS=>$case,MSG=>$msg)->Hi();
}

__DATA__
Foo, First Case
Bar, Second Case

EDIT: It just struck me that this is pretty much what happens when you call the DBI. Depending on the parameters you pass, it will use entirely different code while maintaining a (mostly) consistent interface

Answer 1

Ick. Stevan has a very compelling argument that new should always only return an instance of Class. Anything else is confusing to new people learning the system.

You might wanna take a look at MooseX::AbstractFactory. If that won't work for you then:

package FooBar;
use Moose;

has [qw(SUBCLASS MSG)] => ( is => 'ro', required => 1);

sub create_instance {
    return $self->package->new(message => $self->msg);
}

package FooBar::Object;
use Moose;

has msg => ( is => 'ro', required => 1);

sub Hi {
   my $self = shift;
   print "Hi, I'm a " . ref($self)  ." and I say [". $self->MSG()."]\n";
}

package Foo;
use Moose;
extends qw(FooBar::Object);

package Bar;
use Moose;
extends qw(FooBar::Object);


package main;
or my $line (<DATA>) {
   my ($case,$msg)=split(/[\n\r,]\s*/,$line);
   FooBar->new(SUBCLASS=>$case,MSG=>$msg)->create_instance->Hi
}

__DATA__
Foo, First Case
Bar, Second Case

Of course there are many other ways to implement this same concept in Moose. Without knowing the specifics of your domain problem it's hard to tell that something like MooseX::Traits wouldn't be better:

package Foo;
use Moose;
with qw(MooseX::Traits);

package Bar;
use Moose;
with qw(MooseX::Traits);

package Messaging;
use Moose::Role;

has msg => ( is => 'ro', required => 1);

sub Hi {
   my $self = shift;
   print "Hi, I'm a " . ref($self)  ." and I say [". $self->MSG()."]\n";
}

package main;
use strict;
Foo->with_traits('Messaging')->new( msg => 'First Case')->Hi;

This is roughly what the other poster meant about using a Role based solution.