]> git.vpit.fr Git - perl/modules/subs-auto.git/blobdiff - lib/subs/auto.pm
Fix default package
[perl/modules/subs-auto.git] / lib / subs / auto.pm
index 98b02e5636d0d521f3143b7a7b5456e22e5252d5..deeec16cf416a8bcb033925922d3f477db8b4e77 100644 (file)
@@ -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};
  {
@@ -229,6 +238,8 @@ 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.
@@ -263,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.