BOOT:
{
sub_op_config_t c;
- c.name = "reftype";
- c.len = sizeof("reftype")-1;
- c.pp = scalar_util_reftype;
- c.check = 0;
- c.ud = NULL;
+ c.name = "reftype";
+ c.namelen = sizeof("reftype")-1;
+ c.pp = scalar_util_reftype;
+ c.check = 0;
+ c.ud = NULL;
sub_op_register(aTHX_ &c);
}
my $pkg = $data->{pkg};
my $fqn = join '::', $pkg, $name;
- no strict 'refs';
- *$fqn = $placeholder unless exists &$fqn;
+ {
+ local $SIG{__WARN__} = sub {
+ CORE::warn(@_) unless $_[0] =~ /^Constant subroutine.*redefined/;
+ } if _constant_sub(do { no strict 'refs'; \&$fqn });
+ no strict 'refs';
+ no warnings 'redefine';
+ *$fqn = $placeholder;
+ }
return;
},
my $fqn = join '::', $pkg, $name;
return {
+ old => _defined_sub($fqn) ? \&$fqn : undef,
proto => prototype($fqn),
};
}
=item *
-C<STRLEN len>
+C<STRLEN namelen>
C<name>'s length, in bytes.
my $pkg = @_ > 0 ? $_[0] : caller;
my $map = _map($pkg);
+ my $fqn = join '::', $pkg, $name;
+
if (defined $map) {
- my $proto = $map->{$name}->{proto};
+ my $tag = $map->{$name};
+
+ my $old = $tag->{old};
+ if (defined $old) {
+ no strict 'refs';
+ no warnings 'redefine';
+ *$fqn = $old;
+ }
+
+ my $proto = $tag->{proto};
if (defined $proto) {
no strict 'refs';
- Scalar::Util::set_prototype(\&{"${pkg}::$name"}, $proto);
+ Scalar::Util::set_prototype(\&$fqn, $proto);
}
delete $map->{$name};
See the F<t/Sub-Op-LexicalSub> directory that implements a complete example.
+=head1 CAVEATS
+
+Preexistent definitions of a sub whose name is handled by L<Sub::Op> are restored at the end of the lexical scope in which the module is used.
+But if you define a sub in the scope of action of L<Sub::Op> with a name that is currently being replaced, the new declaration will be obliterated at the scope end.
+
=head1 DEPENDENCIES
L<perl> 5.10.