Lexically scoped subs'R'Us

broquaint on 2002-04-20T17:56:48

After finally having realised that perl really does't do nested subs (lamented here) I decided to take the next obvious step and write a module that gives the illusion of having nested subs

#!/usr/bin/perl

package MySub;

use strict;

use Regexp::Common;

my $brackets_re     = $RE{balanced}{-parens => '{}'};
my $paren_re        = $RE{balanced}{-parens => '()'};

my $sub_name_re     = qr/[_a-zA-Z](?:\w+)?/;
my $sub_match_re    = qr/my\s+sub\s+($sub_name_re)\s*($brackets_re)\s*;?/x;
                      
                      # my sub foobar { "code" }
                      # my               # 'my'
                      # \s+              # 1> space
                      # sub              # 'sub'
                      # \s+              # 1> space
                      # ($sub_name_re)   # '$subname'
                      # \s*              # 0> space
                      # ($brackets_re)   # balanced {}
                      # \s*              # 0> space
                      # ;?               # optional ';'

use Filter::Simple;

my @subs;
# FILTER_ONLY code => sub {
FILTER {
    my $code = $_;
    study $code;

    while(my($subname, $subcode) = $code =~ /$sub_match_re/s) { 
        push @subs, {
            subname     => $subname,
            code        => $subcode
        };
    
        # 'my sub name {}' => 'my $name = sub {};'
        $code =~ s/$sub_match_re/my \$$1 = sub $2;\n/s;
    
        # '&name();' => '$name->();'
        $code =~ s/
                    &?               # optional &
                    $subname         # '$subname'
                    \s*              # 0> whitespace
                    (                # group $1
                        $paren_re    # balanced parens
                    )?               # optional group $1
                    \s*              # 0> whitespace
                    ;                # ';'
                  /"\$$subname->" . ($1 || '()') . ';'/sex;
    }

    $_ = $code;
};

qw(package activated);

Although the code is a little rough, it seems to DWIM so far. I haven't done any extensive testing (note to self - learn how to use test suites) but I havent found any problems as of yet. Once it's tidyed up a bit, I might even stick it on CPAN depending on the peoples' need for such an extension.

broquaint out

---

Here's one I made earlier ...

broquaint on 2002-04-20T19:01:20

Here's some basic test code and subsequent output for anyone interested.

use strict;
use warnings;

use MySub;

sub foo {
    print "in foo()\n";
    my $lv = "a lex var in foo()";

    my sub bar {
        print "\tin bar()\n";
        print "\tgot args - @_\n";
        print "\t\$lv is $lv\n";
       
        my $bar_args = \@_;
       
        my sub quux {
            print "\t\tin quux()\n";
            print "\t\tbar() args = @$bar_args\n";
        }

        quux();
    }

    &bar(qw(a bunch of args));
}

foo();

exit(0);

__output__
in foo()
        in bar()
        got args - a bunch of args
        $lv is a lex var in foo()
                in quux()
                bar() args = a bunch of args