| Subject: | Method can't be PROTECTED and CUMULATIVE simultaneously |
Compilation of attached stdtest.pl fails with error:
Can't make anonymous subroutine cumulative at stdtest.pl line 0
It's because _find_sub() can't find already replaced sub in symbol table.
To fix it, _find_sub() must cache symbol lookups, as in attached version.
Also, order of initialization must be changed: e.g., RESTRICTED
attributes must be applied after CUMULATIVE ones. In find_sub.pl attach
there is fixed version.
Probably, this _find_sub() must be factored out in separate module,
which will be used both by Class::Std and other attribute-using
sub-redefining modules.
| Subject: | stdtest.pl |
#!/usr/bin/perl
# -*- encoding: utf-8; tab-width: 8 -*-
use strict;
use warnings;
use utf8;
use Carp;
use English '-no_match_vars';
use version; our $VERSION = qv('1.0.0');
package Wax::Floor;
use Class::Std;
{
my %name_of :ATTR( init_arg => 'name' );
my %patent_of :ATTR( init_arg => 'patent' );
sub real_describe {
my ( $self ) = @_;
$self->describe;
}
sub describe :CUMULATIVE RESTRICTED {
my ($self) = @_;
print "The floor wax $name_of{ident $self} ",
"(patent: $patent_of{ident $self})\n";
return;
}
}
package Topping::Dessert;
use Class::Std;
{
my %name_of :ATTR( init_arg => 'name' );
my %flavour_of :ATTR( init_arg => 'flavour' );
sub describe :CUMULATIVE RESTRICTED {
my ($self) = @_;
print "The dessert topping $name_of{ident $self} ",
"with that great $flavour_of{ident $self} taste!\n";
return;
}
}
package Shimmer;
use base qw( Wax::Floor Topping::Dessert );
use Class::Std;
{
my %name_of :ATTR( init_arg => 'name' );
my %patent_of :ATTR( init_arg => 'patent' );
sub describe :CUMULATIVE RESTRICTED {
my ($self) = @_;
print "New $name_of{ident $self} ",
"(patent: $patent_of{ident $self})\n",
"Combining...\n";
return;
}
}
package main;
my $product
= Shimmer->new({
name => 'Shimmer',
patent => 1562516251,
flavour => 'Vanilla',
});
$product->real_describe();
| Subject: | find_sub.pl |
my %_find_sub_cache;
sub _find_sub {
my ($package, $sub_ref) = @_;
no strict 'refs';
if (my $it = $_find_sub_cache{$package}{$sub_ref}) {
return $it;
}
for my $name (keys %{$package.'::'}) {
my $candidate = *{$package.'::'.$name}{CODE};
if ($candidate && $candidate == $sub_ref) {
$_find_sub_cache{$package}{$sub_ref} = $name;
return $name;
}
}
croak q{Can't make anonymous subroutine cumulative};
}