It's not quite that simple: I know that bit works - that's why I'm using it - but I wasn't sure that it would work in a subclass. And you're quite right: I should have just tried it. So:

package Drone;
sub new { return bless {}, shift; }
1;

package Factory;
no strict 'refs';
sub fixup {
    *Drone::bar = sub { return __PACKAGE__ };
}
1;

package Subfactory;
use base qw( Factory );
1;

package main;
Subfactory->fixup;
my $foo = Drone->new;
print $foo->bar . "\n";
[download]

And it looks like the answer is no: this code prints 'Factory' for me, where I want it to say 'Subfactory'. Curses. So how can I get the name of the inheriting package inside the anonymous sub when fixup() is called? I guess I'll have to put in a package_name method and do it literally.

Thanks for putting my mind at rest about the other thing.

I know I'm not grasping all of your requirements here ... so maybe this will help you along your way.

package Drone;
sub new { return bless {}, shift; }
1;

package Factory;
no strict 'refs';
sub fixup {
    #*Drone::bar = sub { return __PACKAGE__ };
    my $class = shift || __PACKAGE__;
    *Drone::bar = sub { return $class };
}
1;

package Subfactory;
use base qw( Factory );
1;

package main;
Subfactory->fixup;
my $foo = Drone->new;
print $foo->bar . "\n";
[download]

This prints out "Subfactory".

Thank you! That won't work in my real situation, because I won't be calling a class method like that, but you made me realise that instead of __PACKAGE__, I just need to call ref $self, which will inherit properly. D'oh:

    my $self = shift;
    my $factory_class=ref $self;
    *Foo::bar = sub { return $factory_class->instance; };
[download]

I definitely am creating a closure now, but I don't think it will matter: it's only a simple scalar that gets unnaturally prolonged.

Thanks.

If it's a method, you could use:

package Factory;

sub fixup {
    no strict 'refs';
    *Drone::bar = sub {
       my $self = shift;
       my $class = ref($self);
       return $class;
    };
}

package main;

Factory::fixup();

@Drone::Subclass::ISA = 'Drone';
my $drone1 = bless({}, 'Drone');
my $drone2 = bless({}, 'Drone::Subclass');

print($drone1->bar(), $/);  # Prints Drone
print($drone2->bar(), $/);  # Prints Drone::Subclass
[download]

or you could also use closures:

package Factory;

sub fixup {
    no strict 'refs';
    my $pkg = 'Drone';
    *{"${pkg}::bar"} = sub { return $pkg; };
}

package main;

Factory::fixup();

@Drone::Subclass::ISA = 'Drone';
my $drone1 = bless({}, 'Drone');
my $drone2 = bless({}, 'Drone::Subclass');

print($drone1->bar(), $/);  # Prints Drone
print($drone2->bar(), $/);  # Prints Drone
[download]

Note the slightly different output. I don't know which you would prefer.

I'm sorry: I think I was very unclear in the original question, and simplified away the wrong bits. It's the package name of the factory that I want to capture in a method injected into the Drone class, so that the Drone (no idea why I called it that) can call instance() on the right factory class.

The answer turns out to be very simple, and much the same as your neat constructions:

sub post_require { 
    my ($self, $class) = shift;
    my $factory_class=ref $self;
    no strict 'refs';
    *{"$class::factory"} = sub { return $factory_class->instance; };
}
[download]

but it does look like I can't do it without creating some kind of closure, which I was hoping to avoid...

Thanks for your help.