10 use Variable::Magic qw/wizard cast dispell getdata/;
14 subs::auto - Read barewords as subroutine names.
22 our $VERSION = '0.01';
28 foo; # Compile to "foo()" instead of "'foo'"
29 # or croaking on strict subs
30 foo $x; # Compile to "foo($x)" instead of "$x->foo"
31 foo 1; # Compile to "foo(1)" instead of croaking
32 foo 1, 2; # Compile to "foo(1, 2)" instead of croaking
34 foo->meth; # "'foo'->meth" if you have use'd foo somewhere,
35 # or "foo()->meth" otherwise
36 print foo 'wut'; # print to the filehandle foo if it's actually one,
37 # or "foo()->print('wut')" otherwise
38 } # ... but function calls will fail at run-time if you don't
39 # actually define foo somewhere
45 This pragma lexically enables the parsing of any bareword as a subroutine name, except those which corresponds to an entry in C<%INC> (expected to be class names) or whose symbol table entry has a IO slot (expected to be filehandles).
50 if (!Variable::Magic::VMG_UVAR) {
52 Carp::croak('uvar magic not available');
56 my @core = qw/abs accept alarm atan2 bind binmode bless break caller chdir
57 chmod chomp chop chown chr chroot close closedir connect
58 continue cos crypt dbmclose dbmopen default defined delete die
59 do dump each endgrent endhostent endnetent endprotoent endpwent
60 endservent eof eval exec exists exit exp fcntl fileno flock fork
61 format formline getc getgrent getgrgid getgrnam gethostbyaddr
62 gethostbyname gethostent getlogin getnetbyaddr getnetbyname
63 getnetent getpeername getpgrp getppid getpriority getprotobyname
64 getprotobynumber getprotoent getpwent getpwnam getpwuid
65 getservbyname getservbyport getservent getsockname getsockopt
66 given glob gmtime goto grep hex index int ioctl join keys kill
67 last lc lcfirst length link listen local localtime lock log
68 lstat map mkdir msgctl msgget msgrcv msgsnd my next no oct open
69 opendir ord our pack package pipe pop pos print printf prototype
70 push quotemeta rand read readdir readline readlink readpipe recv
71 redo ref rename require reset return reverse rewinddir rindex
72 rmdir say scalar seek seekdir select semctl semget semop send
73 setgrent sethostent setnetent setpgrp setpriority setprotoent
74 setpwent setservent setsockopt shift shmctl shmget shmread
75 shmwrite shutdown sin sleep socket socketpair sort splice split
76 sprintf sqrt srand stat state study sub substr symlink syscall
77 sysopen sysread sysseek system syswrite tell telldir tie tied
78 time times truncate uc ucfirst umask undef unlink unpack unshift
79 untie use utime values vec wait waitpid wantarray warn when
85 delete @core{qw/my local/};
88 my $tag = wizard data => sub { 1 };
91 my ($pkg, $func) = @_;
92 my $fqn = join '::', @_;
98 if ($cb and getdata(&$cb, $tag)) {
101 for (qw/SCALAR ARRAY HASH IO FORMAT/) {
103 *$sym = *$fqn{$_} if defined *$fqn{$_}
111 (undef, my $data, my $func) = @_;
112 return if $data->{guard};
113 return unless $func !~ /::/ and not exists $core{$func};
114 local $data->{guard} = 1;
115 my $hints = (caller 0)[10];
116 if ($hints and $hints->{bareword}) {
117 my $mod = $func . '.pm';
118 if (not exists $INC{$mod}) {
119 my $fqn = $data->{pkg} . '::' . $func;
120 if (do { no strict 'refs'; not *$fqn{CODE} and not *$fqn{IO}}) {
122 my ($file, $line) = (caller 0)[1, 2];
123 ($file, $line) = ('(eval 0)', 0) unless $file && $line;
124 die "Undefined subroutine &$fqn called at $file line $line\n";
132 _reset($data->{pkg}, $func);
138 (undef, my $data, my $func) = @_;
139 return if $data->{guard};
140 local $data->{guard} = 1;
141 _reset($data->{pkg}, $func);
145 my $wiz = wizard data => sub { +{ pkg => $_[1] } },
156 cast %{$pkg . '::'}, $wiz, $pkg;
167 dispell %{$_ . '::'}, $wiz for keys %pkgs;
177 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 ?).
183 L<Carp> (standard since perl 5), L<Symbol> (since 5.002).
185 L<Variable::Magic> with C<uvar> magic enabled (this should be assured by the required perl version).
189 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
191 You can contact me by mail or on #perl @ FreeNode (vincent or Prof_Vince).
195 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.
199 You can find documentation for this module with the perldoc command.
203 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/subs-auto>.
205 =head1 ACKNOWLEDGEMENTS
207 Thanks to Sebastien Aperghis-Tramoni for helping to name this pragma.
209 =head1 COPYRIGHT & LICENSE
211 Copyright 2008 Vincent Pit, all rights reserved.
213 This program is free software; you can redistribute it and/or modify it
214 under the same terms as Perl itself.
218 1; # End of subs::auto