Redefine package subroutines

[Melly]

Hi Monkees

I have a perl program that I'm rewriting to accommodate the growing list of requirements.

One thing I want/need to do is to have 3 different packages containing subroutines with, potentially, the same names (not a problem).

I will have a global package, GP, a local package, LP, and a file package, FP, so that people can call GP::format_date, or LP::format_date, etc.

My problem is the FP package. GP and LP are loaded at run-time, but FP needs to have its routines reloaded during the program's duration (basically, everytime I switch to a new file, I want to initialise and repopulate FP with routines defined in filename.lib

Any suggestions?

Another nice feature (although not essential) would be to allow the user NOT to specify the package name, and have the program default to FP::routine if it exists, then LP::routine if it exists, before finally defaulting to GP::routine (and returning an error if the routine doesn't exist in any package). I would also need the user to be able to over-ride this by explicitly specifying the package...

As I said, the last requirement is not essential - I can always require the users to specify the package, but it would be nice.

[tobyink]

"LP needs to have its routines reloaded during the program's duration"

You could use Class::Unload to unload the LP package before loading it again.

That said, the entire architecture you're describing sounds weird. I'm pretty sure a solution exists using object orientation, inheritance and dependency injection to solve your underlying problem without any of this FP/LP/GP stuff, but you've not described your underlying problem in anywhere near enough detail.

"Another nice feature (although not essential) would be to allow the user NOT to specify the package name, and have the program default to FP::routine if it exists, then LP::routine if it exists, before finally defaulting to GP::routine (and returning an error if the routine doesn't exist in any package). I would also need the user to be able to over-ride this by explicitly specifying the package..."

Write all your functions as class methods. That is; functions which are called like:

Package->function(@args);   # like this
Package::function(@args);   # not this!

That way you can create an uber package like this:

{
  package AllP;
  use base qw( FP LP GP );
}

Then calling AllP->function will automatically search FP, LP and GP in that order.

[tobyink]

OK, let's have a guess at the kind of thing you're doing. It probably differs in the details.

You have a script that needs to process a large directory tree; perhaps to perform backups or some other automated process. Some directories contain large text log files, which should be compressed before backing up, and once they're backed up they're never going to be modified so this knowledge allows us to shortcut a lot of processing. Other directories contain just images; these need to be backed up by uploading them to Flickr. And so on.

The way I'd approach this might be to keep a set of modules like this:

{
  package Backup::General;
  sub backup_file { my ($class, $file) = @_; ... }
  sub backup_dir {
    my ($class, $dir) = @_;
    opendir my $d, $dir;
    while (readdir $d) {
      next if /^\./ or -d;
      $class->backup_file($_);
    }
  }
  ...
}
{
  package Backup::ImageDir;
  use parent 'Backup::General';
  sub backup_file {
    my ($class, $file) = @_;
    $class->upload_flickr($file) if $file =~ /\.jpeg$/i;
    $class->SUPER::backup_file($file)
  }
  sub upload_flickr { ... }
  ...;
}
{
  package Backup::LogDir;
  use parent 'Backup::General';
  sub backup_dir {...}
  ...
}

Then each directory being backed up could contain a file backup.ini which looked something like this:

backup_class = "Backup::ImageDir"

My backup script would walk through the directories and for each:

use Config::Tiny;
use Module::Runtime qw(use_package);

my $config = Config::Tiny->read("$dir/backup.ini");
my $class  = $config->{_}{backup_class} || 'Backup::General';
use_package($class)->backup_dir($dir);

That way, each directory decides for itself what module will handle its backups. There's no central list of backup modules; no limit to the number of different modules to choose from; the modules are loaded on demand as required.

This seems to be the sort of thing you want; some sort of general behaviour which can be overridden locally based on factors determined at runtime.

[space_monk]

Is it me, or is he describing class inheritance here?

I think the one paragraph has its FP and LP confused - here is what I think it should be:

My problem is the FP package. GP and LP are loaded at run-time, but FP needs to have its routines reloaded during the program's duration (basically, everytime I switch to a new file, I want to initialise and repopulate FP with routines defined in filename.lib

[Melly]

Okay, I think I'm there, but I'd like to check I'm not doing anything dangerous, and I have one mystery...

Here's the code (I've included the contents of the FP files at the end).

use strict;

{
  package FP;
  sub foo{};
}

package GP;
{
  sub subtest1{return 'Global Test 1';}
  sub subtest2{return 'Global Test 2';}
}

package LP;
{
  sub subtest1{return 'Local Test 1';}
}

{
  package AP;
  use base qw(FP LP GP);
}

#delete_FP(0);
my $FP = 'test1.lib';
require $FP;

print "test1.lib\n";
print GP::subtest1() . "\n"; # uses GP
print FP::subtest1() . "\n"; # use FP subs defined in test1.lib
print AP->subtest1() . "\n"; # as previous
print AP->subtest2() . "\n"; # uses GP as this sub only defined there
print AP->subtest3() . "\n"; # this sub won't exist in a moment...

delete_FP($FP);
$FP = 'test2.lib';
require $FP;

print "\ntest2.lib\n";
print FP::subtest1() . "\n"; # uses FP subs defined in test2.lib
print AP->subtest1() . "\n"; # as previous
print AP->subtest3() . "\n"; # this sub now doesn't exist...

sub delete_FP{
  no strict 'refs';
  my $class = 'FP';
  my $symtab = $class . '::';
  # Delete all symbols except other namespaces
  for my $symbol (keys %{$symtab}) {
    next if $symbol =~ /\A[^:]+::\z/;
    delete $symtab->{$symbol};
  }
  delete $INC{$_[0]} if $_[0]; # in theory not nec. but tidier and all
+ows us to require the same lib again?
  return 1;
}

__END__
#test1.lib file

use strict;
package FP;
sub subtest1{
  return 'FP Test 1';
}
sub subtest3{
  return 'FP Test 3';
}

1;

#test2.lib file

use strict;
package FP;
sub subtest1{
  return 'FP Test 2';
}

1;

One mystery - there is a commented out call to delete_FP at line 24. If I don't comment this out, I get an error when I get to "print FP::subtest1()" on line 30, although the subsequent call to delete_FP seems to work fine - any ideas?

[tobyink]

"One mystery - there is a commented out call to delete_FP at line 24. If I don't comment this out, I get an error when I get to "print FP::subtest1()" on line 30, although the subsequent call to delete_FP seems to work fine - any ideas?"

Use FP->subtest1(), not FP::subtest1(). It's all about when the sub name is resolved to its implementation. Colons at compile-time; arrows at run-time. So FP::subtest1() gets bound at compile time to your original subtest1 function, but that gets destroyed when you delete the FP package. Even though you load a new subtest1 implementation, lines 30 and 40 are still bound to the original version of the function which has since disappeared.

[Melly]

Ah! - that's it. Many, many thanks...

[Melly]

One gotcha here if you're not expecting it is that package subroutines set $_[0] to the value on the left-side of ->. So, for example, the following returns 'FP', not 'Hello':

print FP->subtest1('Hello');
package FP;{sub subtest1{return shift;}}