Get rid of Symbol and delete the code slot in XS

It's the only way we have to preserve the GV file name.

diff --git a/MANIFEST b/MANIFEST
index d86f980ce9cdf3792b364aec12779a9e16c5eaeb..6444bebe0a8ba62ce2e25db9452f56eb87202d76 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3,6 +3,7 @@ MANIFEST
 META.yml
 Makefile.PL
 README
 META.yml
 Makefile.PL
 README

+auto.xs

 lib/subs/auto.pm
 samples/subs.pl
 t/00-load.t
 lib/subs/auto.pm
 samples/subs.pl
 t/00-load.t

diff --git a/Makefile.PL b/Makefile.PL
index 7927178383b668f2db3e501657811ac3848a4269..ed2e049e1f88af060fae355c8cbc96ed3195d0a6 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -14,8 +14,8 @@ $file = "lib/$file.pm";
 my %PREREQ_PM = (
  'B::Keywords'     => 0,
  'Carp'            => 0,
 my %PREREQ_PM = (
  'B::Keywords'     => 0,
  'Carp'            => 0,

- 'Symbol'          => 0,

  'Variable::Magic' => '0.08',
  'Variable::Magic' => '0.08',

+ 'XSLoader'        => 0,

 );
 
 my %META = (
 );
 
 my %META = (

diff --git a/auto.xs b/auto.xs
new file mode 100644 (file)
index 0000000..35439a0
--- /dev/null
+++ b/auto.xs
@@ -0,0 +1,24 @@
+/* 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);

diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm
index 3cc549d6dfb05107c06a33da74d0678baf259078..98b02e5636d0d521f3143b7a7b5456e22e5252d5 100644 (file)
--- a/lib/subs/auto.pm
+++ b/lib/subs/auto.pm
@@ -5,12 +5,6 @@ use 5.010;
 use strict;
 use warnings;
 
 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.
 =head1 NAME
 
 subs::auto - Read barewords as subroutine names.


@@ -21,7 +15,10 @@ Version 0.05
 
 =cut
 
 
 =cut
 

-our $VERSION = '0.05';
+our $VERSION;
+BEGIN {
+ $VERSION = '0.05';
+}

 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 


@@ -62,11 +59,19 @@ This module is B<not> a source filter.
 
 =cut
 
 
 =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');
  }
 BEGIN {
  unless (Variable::Magic::VMG_UVAR) {
   require Carp;
   Carp::croak('uvar magic not available');
  }

+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);

 }
 
 my %core;
 }
 
 my %core;


@@ -84,9 +89,8 @@ BEGIN {
 my $tag = wizard data => sub { \(my $data = _REFCNT_PLACEHOLDERS ? 2 : 1) };
 
 sub _reset {
 my $tag = wizard data => sub { \(my $data = _REFCNT_PLACEHOLDERS ? 2 : 1) };
 
 sub _reset {

- my ($pkg, $func) = @_;
-

  my $fqn = join '::', @_;
  my $fqn = join '::', @_;

+

  my $cb = do {
   no strict 'refs';
   no warnings 'once';
  my $cb = do {
   no strict 'refs';
   no warnings 'once';


@@ -97,14 +101,7 @@ sub _reset {
   $$data--;
   return if $$data > 0;
 
   $$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);

  }
 }
 
  }
 }
 


@@ -236,12 +233,12 @@ You have to open global filehandles outside of the scope of this pragma if you w
 
 L<perl> 5.10.0.
 
 
 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<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>.
 =head1 AUTHOR
 
 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.