X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2Fsubs%2Fauto.pm;h=66c26a34b5b97911417460d188727cecc2a10b5a;hb=202c2da3c787f5d6f1c71b16594dc543336b40f6;hp=0625cc68078143780a94d44baace6d99a9f4259d;hpb=c31abfbd7888d62dabfd301cc5f7435d7897e63f;p=perl%2Fmodules%2Fsubs-auto.git diff --git a/lib/subs/auto.pm b/lib/subs/auto.pm index 0625cc6..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.01 +Version 0.04 =cut -our $VERSION = '0.01'; +our $VERSION = '0.04'; =head1 SYNOPSIS @@ -35,7 +35,7 @@ our $VERSION = '0.01'; 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 @@ -53,10 +53,12 @@ You can pass options to C as key / value pairs : C<< in => $pkg >> -Specifies on which package the pragma should act. Defaults to the current package. +Specifies on which package the pragma should act. Setting C<$pkg> to C allows you to resolve all functions name of the type C 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 +This module is B a source filter. + =cut BEGIN { @@ -88,7 +90,7 @@ my @core = qw/abs accept alarm atan2 bind binmode bless break caller chdir time times truncate uc ucfirst umask undef unlink unpack unshift untie use utime values vec wait waitpid wantarray warn when write/; -push @core,qw/not __LINE__ __FILE__/; +push @core,qw/not __LINE__ __FILE__ DATA/; my %core; @core{@core} = (); @@ -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