X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2Fsubs%2Fauto.pm;h=928ea7e51bf8401b9f4648e9629d7ed27c88eac5;hb=c6f479c1cfb222821a7770155ee3fd18f44e0992;hp=465d2d8dca084e97e03228bceb21ca8b002a53a2;hpb=cd69c4462701dfb279e6a38447c1c3df768437cc;p=perl%2Fmodules%2Fsubs-auto.git diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm index 465d2d8..928ea7e 100644 --- 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) { @@ -108,15 +108,23 @@ sub _reset { 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))) { @@ -136,7 +144,7 @@ sub _fetch { no strict 'refs'; *$fqn = $cb; } else { - _reset($data->{pkg}, $func); + _reset($pkg, $func); } return; @@ -153,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; @@ -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.