X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Fsubs-auto.git;a=blobdiff_plain;f=lib%2Fsubs%2Fauto.pm;h=c079d7cc2c830011ee1ce9719c9eab89c2567820;hp=9ec068731be7f8660edc98329e626809bc03baed;hb=d027f9e2d01eea3b32eff74cc1e89fae7e8927df;hpb=27e144152262c7db7af02f0959345e201650e479

diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm
index 9ec0687..c079d7c 100644
--- a/lib/subs/auto.pm
+++ b/lib/subs/auto.pm
@@ -11,13 +11,13 @@ subs::auto - Read barewords as subroutine names.
 
 =head1 VERSION
 
-Version 0.05
+Version 0.06
 
 =cut
 
 our $VERSION;
 BEGIN {
- $VERSION = '0.05';
+ $VERSION = '0.06';
 }
 
 =head1 SYNOPSIS
@@ -51,7 +51,11 @@ You can pass options to C<import> as key / value pairs :
 
 C<< in => $pkg >>
 
-Specifies on which package the pragma should act. Setting C<$pkg> to C<Some::Package> allows you to resolve all functions name of the type C<Some::Package::func ...> in the current scope. You can use the pragma several times with different package names to allow resolution of all the corresponding barewords. Defaults to the current package.
+Specifies on which package the pragma should act.
+Setting C<$pkg> to C<Some::Package> allows you to resolve all functions name of the type C<Some::Package::func ...> in the current scope.
+You can use the pragma several times with different package names to allow resolution of all the corresponding barewords.
+
+Defaults to the current package.
 
 =back
 
@@ -63,7 +67,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,20 +110,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 = $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;
@@ -138,26 +148,27 @@ sub _fetch {
   no strict 'refs';
   *$fqn = $cb;
  } else {
-  _reset($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;
 
@@ -195,7 +206,7 @@ sub import {
  }
  my %args = @_;
 
- my $cur = (caller 1)[0];
+ my $cur = caller;
  my $in  = _validate_pkg $args{in}, $cur;
  ++$pkgs{$in};
  {
@@ -227,9 +238,13 @@ None.
 
 =head1 CAVEATS
 
-C<*{'::foo'}{CODE}> will appear as defined in a scope where the pragma is enabled, C<foo> is used as a bareword, but is never actually defined afterwards. This may or may not be considered as Doing The Right Thing. However, C<*{'::foo'}{CODE}> will always return the right value if you fetch it outside the pragma's scope. Actually, you can make it return the right value even in the pragma's scope by reading C<*{'::foo'}{CODE}> outside (or by actually defining C<foo>, which is ultimately why you use this pragma, right ?).
+C<*{'::foo'}{CODE}> will appear as defined in a scope where the pragma is enabled, C<foo> is used as a bareword, but is never actually defined afterwards.
+This may or may not be considered as Doing The Right Thing.
+However, C<*{'::foo'}{CODE}> will always return the right value if you fetch it outside the pragma's scope.
+Actually, you can make it return the right value even in the pragma's scope by reading C<*{'::foo'}{CODE}> outside (or by actually defining C<foo>, which is ultimately why you use this pragma, right ?).
 
-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.
+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>.
 
@@ -251,7 +266,8 @@ You can contact me by mail or on C<irc.perl.org> (vincent).
 
 =head1 BUGS
 
-Please report any bugs or feature requests to C<bug-subs-auto at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=subs-auto>.  I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
+Please report any bugs or feature requests to C<bug-subs-auto at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=subs-auto>.
+I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 
 =head1 SUPPORT