Factory Pattern

tomazos has asked for the wisdom of the Perl Monks concerning the following question:

A recurring pattern that occurs is that you want to construct instances from a class hierarchy based on some typeless data (eg, deserializing a string).

Taking a typical barnyard example:

package Animal;
package Sheep; @ISA = ('Animal');
package Cow; @ISA = ('Animal');
package Pig; @ISA = ('Animal');
[download]

A new animal wanders into your program and identifies itself with a noise. Either "baa", "moo" or "oink".

You could do this:

sub make_animal
{
    my ($sound) = @_;
    if ($sound =~ /baa/)  { return Sheep->new; }
    if ($sound =~ /moo/)  { return Cow->new; }
    if ($sound =~ /oink/) { return Pig->new; }
}
[download]

The problem is that each time you define a new animal, you have to update your make_animal function.

What would be better is if within the class somehow the animal "registered" itself against the sound it makes.

We can do that by creating a global hash, and then each animal class enters itself into this hash:

package Sheep;

BEGIN {
   our %::animal_sounds;
   $::animal_sounds{'baa'} = 'Sheep';
}
[download]

And then the make_animal function becomes:

sub make_animal
{
    my ($sound) = @_;

    foreach my $sounds_like (keys %::animal_sounds)
    {
       if ($sound =~ /$sounds_like/)
       {
          return ($::animal_sounds{$sounds_like})->new;
       }
    }
}
[download]

This function then would not change when a new Animal is added to the hierarchy.

Can anyone recommend any ways of cleaning this up? Is there a more elegant way of doing what I am trying to do? Without using BEGIN blocks and a global hash perhaps? Or without breaking any strictures?

Is there a CPAN module that does something similiar to this?

-Andrew.

Comment on Factory Pattern Select or Download Code

Replies are listed 'Best First'.
Re: Factory Pattern by merlyn (Sage) on Jun 21, 2006 at 10:29 UTC
I would try something more like: `package Cow; use base qw(Animal); __PACKAGE__->makes_sound_like('moo'); ...` [download] Then any parent class that chooses to squirrel that away can add: `package Animal; sub makes_sound_like { my $class = shift; my $sound = shift; our %sound_registry; if (exists $sound_registry{$sound}) { croak "two animals want the sound $sound\n"; } else { $sound_registry{$sound} = $class; } }` [download] Now the factory method can consult the locally prepared table, and can change the storage representation without all the derived classes being aware. In other words, this setup is far less maintainence, and far less typing the same thing twice or more. At least, that's how I'd design it. {grin} -- Randal L. Schwartz, Perl hacker Be sure to read my standard disclaimer if this is a reply.	[reply] [d/l] [select]
Re: Factory Pattern by Corion (Patriarch) on Jun 21, 2006 at 10:40 UTC
You shouldn't have the `%animal_sounds` as a global variable in the main namespace (`main::` or `::`), but maybe have it as a global variable in the `Animal::` namespace. You don't need the BEGIN blocks around your animal registration section, and you also don't break stricture. Personally, I would use any of the Pluggable modules, like Module::Pluggable, especially when you want new plugins to become automatically discovered when they are available: package Animal; use Carp qw(croak); use Module::Pluggable require => 1, search_path => 'Animal', sub_name => known_animals; # use Memoize; # memoize('known_animals'); my @known_animals = __PACKAGE__->known_animals; my %animal_sounds; for my $animal (@known_animals) { for my $sound ($animal->sounds) { croak "Ambigous sound '$sound' ($animal / $animal_sounds{$soun +d})" if exists $animal_sounds{$sound}; $animal_sounds{$sound} = $animal; }; }; # and in a separate file Animal/Dog.pm: package Animal::Dog; sub sounds { 'woof' }; [download]	[reply] [d/l] [select]
Re: Factory Pattern by adrianh (Chancellor) on Jun 22, 2006 at 07:12 UTC
Can anyone recommend any ways of cleaning this up? Is there a more elegant way of doing what I am trying to do? Without using BEGIN blocks and a global hash perhaps? Or without breaking any strictures? What I'd do is let each animal declare what sound it made... `{ package Animal; use Carp qw( croak ); sub new { bless \my $scalar, shift }; } { package Sheep; use base 'Animal'; sub makes_sound { "baa" } } { package Cow; use base 'Animal'; sub makes_sound { "moo" } } { package Pig; use base 'Animal'; sub makes_sound { "oink" } }` [download] then introspected the class hierarchy to find the animals that did what I wanted `use Devel::Symdump; sub make_animal { my $sound = shift; my @animals_that_make_sound = grep { eval { $_->isa( 'Animal' ) && $_->makes_sound eq $sou +nd } } Devel::Symdump->rnew->packages; die "more than one animal can $sound\n" if @animals_that_make_soun +d > 1; die "no animals $sound\n" unless @animals_that_make_sound; return $animals_that_make_sound[0]->new; } print make_animal( 'oink' );` [download]	[reply] [d/l] [select]


XP is just a number
	PerlMonks