Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

broquaint (2964)

broquaint
  (email not shown publicly)

Journal of broquaint (2964)

Saturday April 20, 2002
12:56 PM

Lexically scoped subs'R'Us

[ #4338 ]
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

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • 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 s

    --

    broquaint out