[hijacking london-list as the sub-approx list hasn't been set up yet]
Last week, Mark Fowler was asking about how to subclass Sub::Approx. I said that it was impossible as Sub::Approx wasn't really a class in any meaningful meaning of the word. However, when Mark explained what he wanted to do, I realised that it was actually quite useful and might actually lead to Sub::Approx being used in _real_ systems (which is obviously a good thing!)
What Mark wanted (and I'm paraphrasing here) was to write a module which used the mechanics of Sub::Approx but imposed its own definition of what constitutes a matching subroutine. Most of the difficult stuff already exists in Sub::Approx so it would be a bad thing if you couldn't reuse this framework in some way.
Anyway I thought that this was a very admirable goal and promised to give it some attention. As it turns out, I didn't have to give it much attention at all as the solution popped into my head over the weekend.
All you need to do is to create a module which includes a subroutine which implements your matching criteria and a custom import function. Within the import function you 'require' and 'import' Sub::Approx, passing the import call a reference to your matching function. When Sub::Approx->import returns, your AUTOLOAD function has been overwritten with a Sub::Approx one which will call your function to match subroutine names. All you have to then is to install this new AUTOLOAD function into your calling package.
As an example of this, I've included a specialised matcher which allows you to spell subroutine names backwards together with a simple test program. I'll probably include this stuff in a new distribution of Sub::Aprrox in the next few days.
Don't say I never give you anything useful :)
Dave...
=== Reverse.pm ===
package Reverse;
sub import {
require Sub::Approx;
Sub::Approx->import(match=>\&my_matcher);
my $pkg = caller(0);
*{"${pkg}::AUTOLOAD"} = \&AUTOLOAD;
}
sub my_matcher {
my ($func, @funcs) = @_;
my $rev = reverse $func;
return grep { /$rev/ } @funcs;
}
1;
=== test.pl ===
#!/usr/local/bin/perl -w
use Reverse;
use strict;
sub abc {
print "In sub abc.\n";
}
&cba;
