=cut
+use Scalar::Util;
+
use B::Hooks::EndOfScope;
use Variable::Magic 0.08;
},
);
+sub _tag {
+ my ($pkg, $name) = @_;
+
+ my $fqn = join '::', $pkg, $name;
+
+ return {
+ proto => prototype($fqn),
+ };
+}
+
sub _map {
my ($pkg) = @_;
sub _cast {
my ($pkg, $name) = @_;
- no strict 'refs';
- Variable::Magic::cast(%{"${pkg}::"}, $sw, $pkg, { $name => 1 });
+ my $map = { $name => _tag(@_) };
+
+ {
+ no strict 'refs';
+ Variable::Magic::cast(%{"${pkg}::"}, $sw, $pkg, $map);
+ }
+
+ return $map;
}
sub _dispell {
my $name = shift;
my $pkg = @_ > 0 ? $_[0] : caller;
- my $fqn = "${pkg}::$name";
-
my $map = _map($pkg);
if (defined $map) {
- $map->{$name} = 1;
+ $map->{$name} = _tag($pkg, $name);
} else {
- _cast($pkg, $name);
+ $map = _cast($pkg, $name);
+ }
+
+ my $proto = $map->{$name}->{proto};
+ if (defined $proto) {
+ no strict 'refs';
+ Scalar::Util::set_prototype(\&{"${pkg}::$name"}, undef);
}
$^H |= 0x00020000;
my $name = shift;
my $pkg = @_ > 0 ? $_[0] : caller;
- my $fqn = "${pkg}::$name";
-
my $map = _map($pkg);
if (defined $map) {
+ my $proto = $map->{$name}->{proto};
+ if (defined $proto) {
+ no strict 'refs';
+ Scalar::Util::set_prototype(\&{"${pkg}::$name"}, $proto);
+ }
+
delete $map->{$name};
unless (keys %$map) {
_dispell($pkg);
$B_OP_inject{can} = sub {
my ($obj, $meth) = @_;
if ($meth eq 'first') {
- return undef unless defined _custom_name($obj);
+ return undef unless $obj->isa('B::UNOP') or defined _custom_name($obj);
}
$obj->SUPER::can($meth);
};
=head1 EXAMPLES
-See the F<t/Sub-Op-Test> directory that implements a complete example.
+See the F<t/Sub-Op-LexicalSub> directory that implements a complete example.
=head1 DEPENDENCIES