sourcecode
broquaint
<code>
package Sub::Lexical;
$VERSION = 0.7;
use strict;
use Regexp::Common;
use Carp qw(croak cluck);
use constant DEBUG => 0;
sub new {
my $class = shift;
croak('Sub::Lexical constructor must be called as a class method')
if $class ne 'Sub::Lexical';
cluck("arguments passed to new() aren't in pair form")
if @_ % 2 != 0;
## don't stuff list in if it don't fit
my $self = { @_ % 2 == 0 ? @_ : () };
bless($self, $class);
}
my $brackets_re = $RE{balanced}{-parens => '{}'};
my $paren_re = $RE{balanced}{-parens => '()'};
my $sub_name_re = qr{[_a-zA-Z](?:[\w_]+)?};
my $sub_proto_re = qr{\([\$%\\@&\s]*\)};
my $sub_attrib_re = qr{(?:\s*:\s*$sub_name_re\s*(?:$paren_re)?)*}o;
# my sub foobar (proto) : attrib { "code" }
my $sub_match_re = qr/
my
\s+
sub
\s+
($sub_name_re)
\s*
(
${sub_proto_re} ?
${sub_attrib_re} ?
) ?
\s*
(
$brackets_re
) ?
\s*
; ?
/xo;
## core functions which may expect a function e.g goto &foo
my $core_funcs = join '|', qw(do defined eval goto grep map sort undef);
## things that *can't* come before a bareword
my $ops_before = qr/(?<! \$ | % | @ | ' | " ) |
(?>! q. | -> ) |
(?>! q[ ]\w | qq. ) |
(?>! qq[ ]\w )/x;
sub lexfilter {
my $self = shift;
croak('filter_code() must be called as an object method')
unless $self->isa('Sub::Lexical');
my $code = shift;
study $code;
while(my($subname, $subextra, $subcode) = $code =~ /$sub_match_re/) {
push @{$self->{info}}, {
name => $subname,
extra => $subextra,
code => $subcode
};
my $lexname = "\$LEXSUB_${subname}";
## 'my sub name {}' => 'my $name; $name = sub {};'
$code =~ s<$sub_match_re>
<my \$LEXSUB_$1; \$LEXSUB_$1 = sub $2 $3;>g;
## '&name()' => '$name->()'
$code =~ s<
&? # optional &
$subname # 'subname'
\s* # 0+ whitespace
( # group $1
$paren_re # balanced parens
) # optional group $1
>{"$lexname->" . ($1 || '()')}exg;
## 'goto &name' => 'goto &$name'
$code =~ s<($core_funcs) \s* &$subname\b>
<$1 &$lexname>xg;
## '&name' => '$name->(@_)'
$code =~ s{ (?<!\\) &$subname\b}
{$lexname->(\@_)}xg;
## '\&name' => '$name'
$code =~ s<\\ \s* &($sub_name_re)\b>
<\$LEXSUB_$1>xg;
$subname \b ($bracket_re) >{};
}
## 'name' => '$name->()'
$code =~ s{(?: ^ | (?<! LEXSUB_) ( (?: $ops_before | \s+) \s* ) )
$subname \b }
{$1$lexname->()}xmg;
}
return $code;
}
use Filter::Simple;
FILTER_ONLY code => sub {
my $f = Sub::Lexical->new();
$_ = $f->filter_code($_);
};
q(package activated);
__END__
=pod
=head1 NAME
Sub::Lexical - implement lexically scoped subroutines
=head1 SYNOPSIS
use Sub::Lexical;
sub foo {
my @vals = @_;
my sub bar {
my $arg = shift;
print "\$arg is $arg\n";
print "\$vals are @vals\n";
}
bar("just a string");
my sub quux (@) {
print "quux got args [@_]\n";
}
takesub(\&quux, qw(ichi ni san shi));
}
sub takesub {
print "executing given sub\n\t"; shift->(@_[1..$#_])
}
foo(qw(a bunch of args));
=head1 DESCRIPTION
Using this module will give your code the illusion of having lexically
scoped subroutines. This is because where ever a sub is lexically
declared it will really just turn into a C<my()>ed scalar pointing to
a coderef.
However the lexically scoped subs seem to work as one might expect
them to. They can see other lexically scoped variables and subs, and
will fall out of scope like they should. You can pass them around like
coderefs, give them attributes and prototypes too if you're feeling
particularly brave
=head1 SEE ALSO
perlsub, Regex::Common, Filter::Simple
=head1 THANKS
Damian Conway and PerlMonks for giving me the skills and resources to
write this
=head1 AUTHOR
by Dan Brook
=head1 COPYRIGHT
Copyright (c) 2002, Dan Brook. All Rights Reserved. This module is
free software. It may be used, redistributed and/or modified under the
same terms as Perl itself.
=cut
</code>
Now available on CPAN - <tt>[cpan://Sub::Lexical]</tt>
<p/>
See the POD for info about the module.
<p/>
Basically I'm just throwing this out to see if anyone can find any use for this since it's really just syntactic sugar. There's still a couple of bugs but they should go if I ever bother putting it somewhere important like CPAN or the Code Section on Perl Monks. Hey wait a second ... And if anyone actually wants to play about with it a bit further I can provide them with an actual package (tests and all!)
<p/>
Any improvements/suggestions/condemnations welcome
Miscellaneous
/msg [broquaint]