Factory Pattern for Class Heirarchy

[dcorbin]

I'm do tolerably well with Perl Objects but I'm not a guru and I haven't read Conway's book.

I'm looking for an example that will help me through the following (expressed in generic OO terms):

Consider an abstract base class B, and derived classes D1 and D2. I'd like to have factory that instantiates the correct object type (D1 or D2) based on some input argument (Assume the class names are based on the argument. In this example, the argument would be 1 or 2). Thanks.

[chromatic]

Here's my fevered imaginings.

With more than two derived classes, I'd use a hash or perhaps an array in B holding references to the constructors of the derived classes. It depends on how much the program may be extended in the future.

package B;

sub new {
    my $class = shift;    # ignore
    my $type = shift;
    if ($type == 1) {
        return D1->new(@_);
    } elsif ($type == 2) {
        return D2->new(@_);
    } else {
        return undef;
    }    
}

# more as appropriate

package D1;

@D1::ISA = qw( B );

sub new {
    # paranoia check
    # you may not want this and I haven't tested it anyway
    return unless caller eq 'B';
    # more as appropriate
}

package D2;

@D2::ISA = qw( B );

sub new {
    # you may not want this and I haven't tested it anyway
    return unless caller eq 'B';
}

Update: You might have to do something like the following:

package B;

my @models;    # factory model, get it?

sub add {
    my $self = shift;
    my $child_coderef = shift;
    push @models, $child_coderef;
}

sub new {
    my $class = shift;    # ignore
    my $type = shift;
    return unless $type;
    my $child_coderef = @models[$type - 1];
    return unless defined &$child_coderef;
    return $child_coderef->(@_);
}

package D3;

@D3::ISA = qw( B );
use B;    # gotta be done here

B->add(\&new);

sub new {
    # etc
}

That's where I'd start my experimenting. Good luck!

[dcorbin]

I'm afraid I left out a relevant point. I want to be able to add D3 without modifying the existing code. Because of Perl's nature, I know this is viable.

Sorry for the omission.

[tye]

package B;

sub new {
    my $this= shift @_;
    my $type= shift @_;
    return "D$type"->new( @_ );
}

        - tye (but my friends call me "Tye")

[jplindstrom]

A minor comment:

The factory probably isn't going to be contained in the base class (though that certainly is a possibility). So the code above is fine if you just turn it into a method in one of your factory classes.

And depending on your solution, it may be a good idea to consider if you want the method to return the new object or the name of the new class.

One thing to remember is that you need to use D1;, use D2; etc so Perl will load the module and be able to find the new() method of the particular class. That means you still have to modify code when you add a new class (unless you script that too).

/J

[dcorbin]

My thought was that through the use of require or eval { use ... }, the loading of the module could also be dynamic.

[johannz]

Based on your comments, and wanting to explore/ ABUSE an idea, I came up with the following:

#!/usr/bin/perl
use strict;

local $\ = '-' x 40 . "\n";
eval { my $test = CGI::thisFunctionDoesNotExist() };
print $@;

eval { my $test = thisFunctionDoesNotExist CGI() };
print $@;

eval { my $test3 = new Some::Package::That::Doesnt::Exist() };
print $@;

# A function that does not exist in main::
functionThatDoesntExist('test');
exit;

sub UNIVERSAL::AUTOLOAD {
  my $method = $UNIVERSAL::AUTOLOAD;
    
  # So that we have the Carp methods without
  # cluttering up our UNIVERSAL namespace
  use Carp ();
    
  # First, if they are in the main namespace,
  # Fail, since we don't have a package to load
  if ($method =~ /^main::/) {
    Carp::croak("AUTOLOAD failed: $method");
  }
    
  # Else, split the name into package and method names
  my @methodParts = split('::', $method);
  my $methodName = pop(@methodParts);
  my $package = join('::', @methodParts);
    
  # Now, load the package.
  # Die if it fails
  eval "use $package";
  Carp::confess($@) if ($@);
    
  # If you made it here, do standard autoload stuff
    
  # Check which form of method call this is
  # This will catch the packageName::methodName format
  # The methodName packageName format is already good
  if ($_[0] ne $package) {
    unshift @_, $package;
  };
    
  no strict;
  # the goto call will pass along @_ transparently
  goto &$method;
};

This is an example run:

---

~johannz >./autoload.pl
Undefined subroutine CGI::thisFunctionDoesNotExist
----------------------------------------
Undefined subroutine CGI::thisFunctionDoesNotExist
----------------------------------------
Can't locate Some/Package/That/Doesnt/Exist.pm in @INC (@INC contains: /usr/bin/perl/lib/ .) at (eval 3) line 2.
BEGIN failed--compilation aborted at (eval 3) line 2.
        UNIVERSAL::AUTOLOAD('Some::Package::That::Doesnt::Exist') called at ./autoload.pl line 11
        eval {...} called at ./autoload.pl line 11
----------------------------------------
AUTOLOAD failed: main::functionThatDoesntExist at ./autoload.pl line 27
        UNIVERSAL::AUTOLOAD('test') called at ./autoload.pl line 15

---

I would never allow this code past a code review, but it does allow you to make method calls dynamically. Never again will you need to use the EVIL 'use' statement. Down with Clarity, Up with Obfuscation!!!

Note: This whole thing is an example of how perl gives you enough rope to hang yourself. I wanted to explore the possibilities of the what the UNIVERSAL class and AUTOLOAD methods make possible. Indigo was part of the inspiration for this during a talk over the cube walls

[merlyn]

You're gonna hate me for saying this, but check out autouse. {grin}

-- Randal L. Schwartz, Perl hacker

[johannz]

Merlyn, I don't hate you :-)

Actually, I have seen 'autouse' before and had just forgot about it. And it's even in the standard distro. The biggest difference between the 'autouse' module and my code is that my module doesn't require any pre-declaration of what modules you want to use; you just call them and they get loaded. It's a step beyond run-time loading. Not that I'm promoting this as how this should be done; this was just an educational exercise.

In developing this module, I had the chance to look at AUTOLOAD and the 'goto' function and gain a better understanding of what they were capable of. As I said in the notes with my code, this was not something I would put into production code. But it was a demonstration of one way to approach this problem.