--- /dev/null
+/* This file is part of the subs::auto Perl module.
+ * See http://search.cpan.org/dist/subs-auto/ */
+
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+MODULE = subs::auto PACKAGE = subs::auto
+
+PROTOTYPES: ENABLE
+
+void
+_delete_sub(SV *fqn)
+PREINIT:
+ GV *gv;
+PPCODE:
+ gv = gv_fetchsv(fqn, 0, 0);
+ if (gv) {
+ CV *cv = GvCV(gv);
+ GvCV(gv) = NULL;
+ SvREFCNT_dec(cv);
+ }
+ XSRETURN(0);
use strict;
use warnings;
-use B::Keywords;
-
-use Symbol qw/gensym/;
-
-use Variable::Magic qw/wizard cast dispell getdata/;
-
=head1 NAME
subs::auto - Read barewords as subroutine names.
=cut
-our $VERSION = '0.05';
+our $VERSION;
+BEGIN {
+ $VERSION = '0.05';
+}
=head1 SYNOPSIS
=cut
+use B;
+
+use B::Keywords;
+
+use Variable::Magic qw/wizard cast dispell getdata/;
+
BEGIN {
unless (Variable::Magic::VMG_UVAR) {
require Carp;
Carp::croak('uvar magic not available');
}
+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);
}
my %core;
my $tag = wizard data => sub { \(my $data = _REFCNT_PLACEHOLDERS ? 2 : 1) };
sub _reset {
- my ($pkg, $func) = @_;
-
my $fqn = join '::', @_;
+
my $cb = do {
no strict 'refs';
no warnings 'once';
$$data--;
return if $$data > 0;
- no strict 'refs';
- my $sym = gensym;
- for (qw/SCALAR ARRAY HASH IO FORMAT/) {
- no warnings 'once';
- *$sym = *$fqn{$_} if defined *$fqn{$_}
- }
- undef *$fqn;
- *$fqn = *$sym;
+ _delete_sub($fqn);
}
}
L<perl> 5.10.0.
-L<Carp> (standard since perl 5), L<Symbol> (since 5.002).
-
L<Variable::Magic> with C<uvar> magic enabled (this should be assured by the required perl version).
L<B::Keywords>.
+L<Carp> (standard since perl 5), L<XSLoader> (since 5.006).
+
=head1 AUTHOR
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.