Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Factory Pattern for Class Heirarchy

by dcorbin (Sexton)
on Oct 08, 2000 at 04:53 UTC ( [id://35782]=perlquestion: print w/replies, xml ) Need Help??

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

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.

Replies are listed 'Best First'.
Re: Factory Pattern for Class Heirarchy
by chromatic (Archbishop) on Oct 08, 2000 at 05:16 UTC
    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!
      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.

Re: Factory Pattern for Class Heirarchy
by tye (Sage) on Oct 08, 2000 at 07:16 UTC
    package B; sub new { my $this= shift @_; my $type= shift @_; return "D$type"->new( @_ ); }
            - tye (but my friends call me "Tye")
      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

        My thought was that through the use of require or eval { use ... }, the loading of the module could also be dynamic.
RE: Factory Pattern for Class Heirarchy
by johannz (Hermit) on Oct 10, 2000 at 03:48 UTC
    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, 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.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://35782]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (1)
As of 2024-07-21 12:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.