CODEWITHSUNDEEP
perl
nowox
nowox

Reputation: 29086

Preserve local context across nested subroutines

Let's consider the wanted code below. I have recursive calls to process and for each recursion I use a local %context. In this way I can get my context back when I return from a call. 

sub process {
    my %context; # Local context

    process() if rerun();

    job1();
    job2();

    sub job1() {print $context{foo}}
    sub job2() {print $context{bar}}
}

Unfortunately does not manage nested subroutines as I expected. By moving my subroutines outside from the process subroutine I will get a problem because I won't be able to access %context anymore. So I need to make it global and use a stack as follow: 

my %context;        # Local context
my @context_stack;

sub process {
    push @context_stack, %context;
    %context = undef;

    process() if rerun();

    job1();
    job2();

    %context = pop @context_stack;
}

sub job1() {print $context{foo}}
sub job2() {print $context{bar}}

The third solution is to pass the context to all subroutines which can be annoying for very small subroutines. Also %context become global to all my program. So I loose the privacy of this variable. 

my %context;        # Local context
my @context_stack;

sub process {
    push @context_stack, %context;
    %context = undef;

    process() if rerun(\%context);

    job1(\%context);
    job2(\%context);

    %context = pop @context_stack;
}

sub job1() {$context = shift; print $context->{foo}}
sub job2() {$context = shift; print $context->{bar}}

What would be the best approach?

EDIT

For a better understanding of my specific, I provide another example:

process(@ARGV);
exit 0;

sub process {
    my $infile = shift;
    my $outfile = shift;

    open my $fp_in,  '<', $infile;
    open my $fp_out, '>', $outfile;

    LINE: while(<$fp_in>) { 
        remove_c_comment(); 

        say STDERR "File is $infile";

        process($1, "$1.processed") if /#include "(.*?)";
        warning("Huh raisin, no!") if /\braisin/;

        say STDERR "Fill is still $infile";

        print $fp_out $_;
    }

    sub remove_c_comment { s|//.*$|| }
    sub warning { say "[Warning] $infile:$. ".shift() }
}

Upvotes: 0

Views: 138

Answers (1)

Sobrique
Sobrique

Reputation: 53478

The thing you're looking for - but you may not know it - is called a closure. (see also: perlref)

{
    my %context;

    sub job1 { print $context{foo} };
    sub job2 { print $context{bar} };
    sub init_context{ $context{foo} = 1 };
}

Context remains private within this block, but accessible to all the subroutines.

As an alternative - you can return a code reference from a subroutine - like this:

use strict;
use warnings;

sub make_sub_with_context {
    my %context;
    $context{"bar"} = 1;
    return sub { print $context{"bar"}++ };
}

my $job1_with_context = make_sub_with_context();
my $another_job_with_context = make_sub_with_context();
$job1_with_context->();
$job1_with_context->();

$another_job_with_context->();
$another_job_with_context->();
$another_job_with_context->();

Which may be a better example.

Edit:

Following on from your updated example it looks like your problem spec is to iterate a set of files, and (recursively) traverse referenced files.

Sort of like a find but following include directives. I would point out that by doing it that way, what you're doing is potentially going to end up with a loop, which isn't ideal.

Can I suggest instead taking a different approach? Don't recurse:

use strict;
use warnings;

my @files_to_process = @ARGV;
my %done;

while ( my $infile = pop @files_to_process ) {
    next if $done{$infile}++;
    open my $fp_in, '<', $infile or die $!;
    open my $fp_out, '>', $infile . ".processed" or die $!;
    while ( my $line = <$fp_in> ) {
        $line =~ s|\/\/.*$||;
        if ( my ($include) = ( $line =~ m/#include "(.*?)"/ ) ) {
            push @files_to_process, $include;
        }
        print {$fp_out} $line;
    }
    close($fp_out);
    close($fp_in);
}

With a bit more thought, and the expansion that this task needs to process stuff in declaration order - I'd offer instead - perhaps taking an OO approach would help. Something like:

use strict;
use warnings;

package parser;

sub new {
    my ($class) = @_;
    my $self = {};
    bless $self, $class;
    return $self;
}

sub process {
    my ( $self, $infile, $outfile ) = @_;
    open my $fp_in,  '<', $infile;
    open my $fp_out, '>', $outfile;

LINE: while ( my $line = <$fp_in> ) {
        $line =~ s|\/\/.*$||;

        say STDERR "File is $infile";

        if ( my ($includefile) = ( $line =~ m/#include "(.*?)"/ ) ) {
            my $processor = parser->new();
               $processor -> process( $includefile, "$includefile.processed" );
        }
        $self->warning("Huh raisin, no!") if /\braisin/;

        say STDERR "Fill is still $infile";

        print $fp_out $line;
    }
}

package main;

my $processor = parser->new()->process(@ARGV);

Upvotes: 2

Related Questions