X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2Fsubs%2Fauto.pm;h=66c26a34b5b97911417460d188727cecc2a10b5a;hb=202c2da3c787f5d6f1c71b16594dc543336b40f6;hp=87fcc5528712605318d73b56163c74e510f04e1c;hpb=8c014a64b4ed83a697c0109af2c1555bc8c26ae9;p=perl%2Fmodules%2Fsubs-auto.git diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm index 87fcc55..66c26a3 100644 --- a/lib/subs/auto.pm +++ b/lib/subs/auto.pm @@ -16,11 +16,11 @@ subs::auto - Read barewords as subroutine names. =head1 VERSION -Version 0.02 +Version 0.04 =cut -our $VERSION = '0.02'; +our $VERSION = '0.04'; =head1 SYNOPSIS @@ -35,7 +35,7 @@ our $VERSION = '0.02'; foo->meth; # "'foo'->meth" if you have use'd foo somewhere, # or "foo()->meth" otherwise print foo 'wut'; # print to the filehandle foo if it's actually one, - # or "foo()->print('wut')" otherwise + # or "print(foo('wut'))" otherwise } # ... but function calls will fail at run-time if you don't # actually define foo somewhere @@ -57,6 +57,8 @@ Specifies on which package the pragma should act. Setting C<$pkg> to C a source filter. + =cut BEGIN { @@ -119,15 +121,14 @@ sub _reset { sub _fetch { (undef, my $data, my $func) = @_; - return if $data->{guard}; - return unless $func !~ /::/ and not exists $core{$func}; - local $data->{guard} = 1; + return if $data->{guard} or $func =~ /::/ or exists $core{$func}; + $data->{guard} = 1; my $hints = (caller 0)[10]; - if ($hints and $hints->{bareword}) { + if ($hints and $hints->{subs__auto}) { my $mod = $func . '.pm'; if (not exists $INC{$mod}) { my $fqn = $data->{pkg} . '::' . $func; - if (do { no strict 'refs'; not *$fqn{CODE} and not *$fqn{IO}}) { + if (do { no strict 'refs'; not *$fqn{CODE} || *$fqn{IO}}) { my $cb = sub { my ($file, $line) = (caller 0)[1, 2]; ($file, $line) = ('(eval 0)', 0) unless $file && $line; @@ -141,14 +142,16 @@ sub _fetch { } else { _reset($data->{pkg}, $func); } + $data->{guard} = 0; return; } sub _store { (undef, my $data, my $func) = @_; return if $data->{guard}; - local $data->{guard} = 1; + $data->{guard} = 1; _reset($data->{pkg}, $func); + $data->{guard} = 0; return; } @@ -175,14 +178,14 @@ sub import { my %args = @_; my $cur = (caller 1)[0]; my $in = _validate_pkg $args{in}, $cur; - $^H{bareword} = 1; + $^H{subs__auto} = 1; ++$pkgs{$in}; no strict 'refs'; cast %{$in . '::'}, $wiz, $in; } sub unimport { - $^H{bareword} = 0; + $^H{subs__auto} = 0; } { @@ -215,7 +218,7 @@ L with C magic enabled (this should be assured by the req Vincent Pit, C<< >>, L. -You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince). +You can contact me by mail or on C (vincent). =head1 BUGS