package Base::Module;

sub load_config {
    my $class   = shift;
    my $module  = $class->config_module;
    require $module;
}

package Foo::Module;
use base qw(Base::Module);

sub config_module {
    return 'Foo/Config.pm';
}
[download]

Oddly enough, even though I was thinking of this in terms of "inheritance" and "polymorphism", it never occurred to me to take the extra step of actually turning the modules into classes. Thanks for pointing that out.

This feels weirdly like dancing around strict refs. I know it's not.

Would there be anything wrong with doing config_module in the base class as:

sub config_module {
      return __PACKAGE__ . '::Config';
}
[download]

Or such as that, anyway?

for(split(" ","tsuJ rehtonA lreP rekcaH")){print reverse . " "}print "\b.\n";

Would there be anything wrong with doing config_module in the base class as: ...

...the only problem is it wouldn't work ;) — at least not with perrin's code snippet.  One thing is that if you use require with a string (as opposed to a bareword), it must be a valid path fragment (i.e. / in place of ::), inlcuding the trailing .pm. The other thing is that when you declare config_module() in the base class, __PACKAGE__ would always be Base::Module, but the point of the exercise was to load different config variants (associated with Foo, Bar, etc.).

Instead I think I'd have the base class define an init() method which the sub-classes call in a BEGIN:

   BEGIN { __PACKAGE__->init() }

The code in init() could do roughly what you have in your BEGIN block, but I might make it a bit more configurable by using a method to get the config class name and defining that in each sub-class:

   sub config_class { "Foo::Config" }

You could have a default implementation of that method in your base class that does the namespace manipulation.

Does that make sense?

-sam

(And the code you posted doesn't work period since __PACKAGE__ is "Base::Module" in this case, not Foo::Module or Bar::Module!)

Oops... Guess that makes it obvious that I hadn't actually tested this yet other than with the Base version...

Does that make sense?

Yep!

Another common pattern would be to use explicit delegation (as opposed to inheritance, whose method dispatch can be considered a form of implicit delegation). I.e., as usual, put the stuff that remains after factoring out the commonalitities into separate modules that implement the same interface. Then have the base module delegate the respective functionality via method calls on whichever config/DB instance had been plugged in.

It somewhat depends on the context whether it's more appropriate to instantiate those delegates from within the base module, or from the main program, passing them to the constructor. For example, when using the latter approach, it would roughly look like this:

...
my $cfg;
if (whatever) {
    $cfg = Foo::Config->new(...);
} else {
    $cfg = Bar::Config->new(...);
}
my $obj = Base::Module->new( config => $cfg, ...);
...
[download]

Generally, when things get complex, systems based on this simple form of delegation tend to remain more loosely coupled, with less interdependence among modules. In other words, they're often easier to modify in case the requirements should change.  At least that's my personal experience... but I'm pretty sure not everyone would agree :) — YMMV.

BEGIN {
  my $ns = __PACKAGE__;
  $ns =~ s/::[^:]*$//;

  eval "require $ns\::Config";
  "$ns\::Config"->import(qw(x y z));
}
[download]

is the same as

BEGIN {
  ( my $ns = __PACKAGE__ ) =~ s/::[^:]*$//;
  my @syms = qw(x y z);
  eval "use $ns\::Config \@syms";
}
[download]

Then add error checking

BEGIN {
  ( my $ns = __PACKAGE__ ) =~ s/::[^:]*$//;
  my @syms = qw(x y z);
  eval "use $ns\::Config \@syms; 1" or die $@;
}
[download]

Since you import, if can also do the job:

sub qualify_ns {
   ( my $ns = __PACKAGE__ ) =~ s/::[^:]*$//;
   return "$ns\::$_[0]";
}

use if 1, qualify_ns('Config') => qw(x y z);
[download]

BEGIN {
  my $ns = __PACKAGE__;
  $ns =~ s/::[^:]*$//;

  eval "require $ns\::Config";
  "$ns\::Config"->import(qw(x y z));
}
[download]

is the same as

BEGIN {
  ( my $ns = __PACKAGE__ ) =~ s/::[^:]*$//;
  my @syms = qw(x y z);
  eval "use $ns\::Config \@syms";
}
[download]

Then add error checking

BEGIN {
  ( my $ns = __PACKAGE__ ) =~ s/::[^:]*$//;
  my @syms = qw(x y z);
  eval "use $ns\::Config \@syms; 1" or die $@;
}
[download]

Since you import, if can also do the job:

sub qualify_ns {
   ( my $ns = __PACKAGE__ ) =~ s/::[^:]*$//;
   return "$ns\::$_[0]";
}

use if 1, qualify_ns('Config') => qw(x y z);
[download]