thpfft has asked for the wisdom of the Perl Monks concerning the following question:

hello hello. A couple of quick and probably silly questions, if I may, about this:

no strict ('refs');
*{"$class\::_factory"} = sub { 
    return __PACKAGE__->instance;
};

[download]

1. will __PACKAGE__ do the right thing in subclasses that inherit this code? (That is, subclasses of the package containing this snippet, not of $class).

2. does use of __PACKAGE__ here create a closure? I'm hoping that it's disappeared at compile time rather than being interpolated later...

thank you.

Replies are listed 'Best First'.
Re: __PACKAGE__ in anonysub
by blokhead (Monsignor) on Feb 19, 2005 at 19:42 UTC
    Have you tried it? It does what you want. 
    package main;
no strict 'refs';
*Foo::bar = sub { return __PACKAGE__ };
print Foo::bar(); # prints 'main'

    [download]
    As for #2, __PACKAGE__ is changed by the parser into a string constant expression. It is not a language function that is evaluated, it's just a compiler directive. You can see this by checking the output of Deparse on the previous example: 
    *Foo::bar = sub {
    return 'main';
}
;
print Foo::bar();

    [download]

    blokhead

[reply]
[d/l]
[select]

      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.

[reply]
[d/l]

        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".

[reply]
[d/l]

        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.

[reply]
[d/l]
[select]
Re: __PACKAGE__ in anonysub
by borisz (Canon) on Feb 20, 2005 at 00:09 UTC
    __PACKAGE__ does what you expect here, but I doubt that you can subclass from the code.
    Using of __PACKAGE__ makes subclass from this class most of the time impossible. Propably this is not what you do.
    yy is the subclass and the expected output should be YYYY but you get XXYY since the package is hardcoded. 
    package xx;
sub new { bless {}, shift }
sub instance { __PACKAGE__->new }
sub print    { print "XX" }

package yy;
@ISA = qw/xx/;
sub print { print "YY" }

package main;
my $yy = yy->instance;
$yy->print;
my $yyy = yy->new;
$yyy->print

    [download]
    Boris
[reply]
[d/l]

Back to Seekers of Perl Wisdom