Use the op_info feature to prevent hooking of method calls

[perl/modules/subs-auto.git] / lib / subs / auto.pm

diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm
index 3cc549d6dfb05107c06a33da74d0678baf259078..928ea7e51bf8401b9f4648e9629d7ed27c88eac5 100644 (file)
--- a/lib/subs/auto.pm
+++ b/lib/subs/auto.pm
@@ -5,12 +5,6 @@ use 5.010;
 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.
@@ -21,7 +15,10 @@ Version 0.05
 
 =cut
 
-our $VERSION = '0.05';
+our $VERSION;
+BEGIN {
+ $VERSION = '0.05';
+}
 
 =head1 SYNOPSIS
 
@@ -62,11 +59,19 @@ This module is B<not> a source filter.
 
 =cut
 
+use B;
+
+use B::Keywords;
+
+use Variable::Magic 0.31 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;
@@ -84,9 +89,8 @@ BEGIN {
 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';
@@ -97,29 +101,30 @@ sub _reset {
   $$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);
  }
 }
 
 sub _fetch {
  (undef, my $data, my $func) = @_;
 
- return if $data->{guard} or $func =~ /::/ or exists $core{$func};
+ return if $data->{guard};
  local $data->{guard} = 1;
 
+ return if $func =~ /::/
+        or exists $core{$func};
+
+ my $op_name = $_[-1] || '';
+ return if $op_name =~ /method/;
+
+ my $pkg = $data->{pkg};
+
  my $hints = (caller 0)[10];
  if ($hints and $hints->{+(__PACKAGE__)}) {
   my $pm = $func . '.pm';
   return if exists $INC{$pm};
 
-  my $fqn = $data->{pkg} . '::' . $func;
+  my $fqn = $pkg . '::' . $func;
   my $cb = do { no strict 'refs'; *$fqn{CODE} };
   if ($cb) {
    if (_REFCNT_PLACEHOLDERS and defined(my $data = getdata(&$cb, $tag))) {
@@ -139,7 +144,7 @@ sub _fetch {
   no strict 'refs';
   *$fqn = $cb;
  } else {
-  _reset($data->{pkg}, $func);
+  _reset($pkg, $func);
  }
 
  return;
@@ -156,9 +161,10 @@ sub _store {
  return;
 }
 
-my $wiz = wizard data  => sub { +{ pkg => $_[1], guard => 0 } },
-                 fetch => \&_fetch,
-                 store => \&_store;
+my $wiz = wizard data    => sub { +{ pkg => $_[1], guard => 0 } },
+                 fetch   => \&_fetch,
+                 store   => \&_store,
+                 op_info => Variable::Magic::VMG_OP_INFO_NAME;
 
 my %pkgs;
 
@@ -232,16 +238,18 @@ C<*{'::foo'}{CODE}> will appear as defined in a scope where the pragma is enable
 
 You have to open global filehandles outside of the scope of this pragma if you want them not to be treated as function calls. Or just use lexical filehandles and default ones as you should be.
 
+This pragma doesn't propagate into C<eval STRING>.
+
 =head1 DEPENDENCIES
 
 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>.
@@ -266,7 +274,7 @@ Thanks to Sebastien Aperghis-Tramoni for helping to name this pragma.
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2008 Vincent Pit, all rights reserved.
+Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
 
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.