Fix default package

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

diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm
index 465d2d8dca084e97e03228bceb21ca8b002a53a2..deeec16cf416a8bcb033925922d3f477db8b4e77 100644 (file)
--- a/lib/subs/auto.pm
+++ b/lib/subs/auto.pm
@@ -63,7 +63,7 @@ use B;
 
 use B::Keywords;
 
-use Variable::Magic qw/wizard cast dispell getdata/;
+use Variable::Magic 0.31 qw/wizard cast dispell getdata/;
 
 BEGIN {
  unless (Variable::Magic::VMG_UVAR) {
@@ -106,18 +106,26 @@ sub _reset {
 }
 
 sub _fetch {
- (undef, my $data, my $func) = @_;
+ (undef, my $data, my $name) = @_;
 
- return if $data->{guard} or $func =~ /::/ or exists $core{$func};
+ return if $data->{guard};
  local $data->{guard} = 1;
 
+ return if $name =~ /::/
+        or exists $core{$name};
+
+ 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';
+  my $pm = $name . '.pm';
   return if exists $INC{$pm};
 
-  my $fqn = $data->{pkg} . '::' . $func;
-  my $cb = do { no strict 'refs'; *$fqn{CODE} };
+  my $fqn = $pkg . '::' . $name;
+  my $cb  = do { no strict 'refs'; *$fqn{CODE} };
   if ($cb) {
    if (_REFCNT_PLACEHOLDERS and defined(my $data = getdata(&$cb, $tag))) {
     ++$$data;
@@ -136,26 +144,27 @@ sub _fetch {
   no strict 'refs';
   *$fqn = $cb;
  } else {
-  _reset($data->{pkg}, $func);
+  _reset($pkg, $name);
  }
 
  return;
 }
 
 sub _store {
- (undef, my $data, my $func) = @_;
+ (undef, my $data, my $name) = @_;
 
  return if $data->{guard};
  local $data->{guard} = 1;
 
- _reset($data->{pkg}, $func);
+ _reset($data->{pkg}, $name);
 
  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;
 
@@ -193,7 +202,7 @@ sub import {
  }
  my %args = @_;
 
- my $cur = (caller 1)[0];
+ my $cur = caller;
  my $in  = _validate_pkg $args{in}, $cur;
  ++$pkgs{$in};
  {
@@ -265,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.