Paul Saunders (darac) wrote in perl,
Paul Saunders
darac
perl

Being aware of subclasses

Hello,

I just joined the community and I wonder if I could jump straight in with a query.

I am writing a program that, given a directory with some files in it, would do the same functions to that directory, but in different ways based on the contents of the directory. That is, my directory may contain one of a number of different tests and I need to run those tests using different programs.

What I would like to be able to do is say "my $test = SomeClass->new($dir);" and have $test be set to a SomeClass::Foo, SomeClass::Bar etc. More importantly, I'd like the code to work if I, at a later time, create SomeClass::Baz.

I envision there being a detect() method with each class that says whether the given directory is suitable for this type, though clearly that could be done in new() (return undef if it's not suitable).

So, to cut a long story short, the point of my question is this: can I make SomeClass aware of subclasses before they even exist?
  • Post a new comment

    Error

    default userpic
  • 7 comments
http://perldoc.perl.org/perlbot.html

The perldoc would seem to suggest this is not possible.
Of course it's possible. A more interesting question is "is it a good idea"?

Basically, you do something a bit like the following (only without bugs and typos):

sub new 
{
        my ($self, @args) = @_;
        
        # detect_real_class should return "My::Class" or similar
        my $real_class = $self->detect_real_class(); 
        eval "use $real_class";
        die "Help: $@" if $@;
        my $self = eval "$real_class->constructor(\@args)";
        die "Help, help: $@" if $@
        return $self;
}


As someone said, this is basically a factory with an odd name for the factory method.
That would seem to run contrary to whole point of object oriented programming.

There are modules that develop something like an "awareness" to other modules in the sense that they make use of these other modules to get their work done. A fine example comes to mind: DBI. The database drivers (DBD::somedatabase) are not subclasses of DBI, but DBI has to be able to identify those drivers in order to respond to DBI->available_drivers().

So, what is it you're really trying to do?
That would seem to run contrary to whole point of object oriented programming.

It would?

Looks like a fairly straightforward example of the Factory Pattern to me (though "new" is a bit of an unusual name for a factory method) -- a Foo factory gives you something that you can treat as a "Foo" but it might actually be a subclass of "Foo", chosen at runtime.

(Though maybe the Factory Pattern is contrary to the whole point of OOP?)
Might Module::Pluggable help?
If you're asking what I think you're asking, then yes, it's possible. I'm not sure if it's a good idea, but you can try it, and decide afterward whether it was a good idea. (How better to learn, than from experience?)

In fact, I can think of two ways to do this: a magical way, and an OO way. I'll describe the magical way first, because I think it's more fun and more interesting; then I'll describe the OO way, because it's probably better practice.

Magical Way

The magical way involves examining the package's symbol tables, and making direct use of the symbol table entries (which are typeglobs). It takes advantage of the fact that the symbol table for (for example) package SomePackage::Foo is %SomePackage::Foo::, and is therefore an entry named Foo:: in %SomePackage:: (since %SomePackage:: is the symbol table for package SomePackage).

The main advantage of this approach is that it doesn't depend on the subpackages doing anything special to inform SomePackage of their existence; as long as they're named SomePackage::Foo (etc.) and contain a method named detect(…) at the time that SomePackage->construct_into_subpackage(…) is called, they're fair game. The main disadvantage is that it completely sidesteps OO; "subpackage" is defined by the package name, not by @ISA.

#!/usr/bin/perl -w

use strict;

package SomePackage;

# Returns a list of packages named SomePackage::Foo, SomePackage::Bar, and so
# on. Does *not* include packages named SomePackage::Foo::Bar, and so on, but
# you can change it to do that.
sub get_subpackages()
{
 my @ret = ();
 foreach my $key (keys %SomePackage::)
 {
  if($key =~ m/^(.+)::\z/)
  {
   push @ret, "SomePackage::$1";
  }
 }
 return @ret;
}

# If there exists a function named $function_name in the package named
# $package_name, returns its symbol-table entry as a typeglob; otherwise,
# returns ''.
sub get_package_function($$) # ($package_name, $function_name)
{
 my ($package_name, $function_name) = @_;

 my $symtab;
 {
  no strict 'refs';
  $symtab = \%{$package_name . '::'}; # package's symbol-table
 }
 my $glob = $symtab->{$function_name}; # relevant symbol-table-entry
 # confirm that entry exists, and has a CODE (subroutine) part:
 return ''
  unless defined $glob && 'CODE' eq ref *$glob{CODE};
 return $glob;
}

# For each subpackage returned by get_subpackages() that contains detect(...)
# function, calls that function using the provided argument(s), until it finds
# one that returns a true value. Returns the first subpackage whose detect(...)
# method returns a true value, or undef if none does.
sub find_relevant_subpackage(@) # (@args)
{
 my @subpackages = get_subpackages();
 foreach my $subpackage (@subpackages)
 {
  my $glob = get_package_function $subpackage, 'detect';
  next
   unless $glob;
  return $subpackage
   if *$glob{CODE}(@_);
 }
 return undef;
}

# Given one or more arguments, attempts to find a subpackage with a detect(...)
# function that returns a true value. If it finds one, it returns an object
# blessed into that subpackage; otherwise, it returns an object blessed into
# the package this was called with (presumably 'SomePackage'). (Should probably
# actually call a constructor method in the chosen package.)
sub construct_into_subpackage
{
 my $fallback_package = shift; # only used if no detect(...) returns true;
 return bless {}, find_relevant_subpackage(@_) || $fallback_package;
}

package main;

sub SomePackage::Foo::detect { return $_[0] =~ m/foo/; }
sub SomePackage::Bar::detect { return $_[0] =~ m/bar/; }
sub SomePackage::Baz::dummy  { return $_[0] =~ m/bar/; }

print "<", SomePackage->construct_into_subpackage('foo'), ">\n";
print "<", SomePackage->construct_into_subpackage('bar'), ">\n";
print "<", SomePackage->construct_into_subpackage('baz'), ">\n";
OO way

The OO way simply has each package register itself with SomeClass:

#!/usr/bin/perl -w

package SomeClass;

my @registered_subclass_methods;

sub register_subclass_method($) # ($method_ref)
{
 push @registered_subclass_methods, shift;
}

sub construct_into_subclass
{
 foreach my $method_ref (@registered_subclass_methods)
 {
  my $ret = $method_ref->(@_);
  return $ret
   if $ret;
 }

 return bless {};
}



package SomeClass::Foo;

@ISA = qw/SomeClass/;

sub delegated_constructor
{
 return $_[0] =~ m/foo/ ? bless {} : undef;
}

BEGIN { SomeClass::register_subclass_method(\&delegated_constructor); }



package SomePackage::Bar;

@ISA = qw/SomeClass/;

sub delegated_constructor
{
 return $_[0] =~ m/bar/ ? bless {} : undef;
}

BEGIN { SomeClass::register_subclass_method(\&delegated_constructor); }


print "<", SomeClass::construct_into_subclass('foo'), ">\n";
print "<", SomeClass::construct_into_subclass('bar'), ">\n";
print "<", SomeClass::construct_into_subclass('baz'), ">\n";


As you can see, it's a lot simpler, and a lot better in most ways, but a lot less fun. ;-)   (This is a fairly traditional factory pattern. The only deviations are (1) that the factory here is not a factory object, but rather a flat package — it's not even using static methods, but rather just plain functions — and (2) that the objects are being created into subclasses of the factory package (and sometimes into the factory's own package). Traditionally, a factory is a normal kind of object, and is outside the hierarchy of classes that it generates instances of.)