X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2Fsubs%2Fauto.pm;h=c0be5aa09b8ed0b5163cf9281b9d2e7fda0040db;hb=38d92c601799850a3428bf919c6b9f8ba1877cb5;hp=465d2d8dca084e97e03228bceb21ca8b002a53a2;hpb=cd69c4462701dfb279e6a38447c1c3df768437cc;p=perl%2Fmodules%2Fsubs-auto.git diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm index 465d2d8..c0be5aa 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) { @@ -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; @@ -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.