Deferring code on scope change in Perl

Question

I often find it useful to be able to schedule code to be executed upon leaving the current scope. In my previous life in TCL, a friend created a function we called defer.

It enabled code like: set fp [open "x"] defer("close $fp");

which was invoked when the current scope exited. The main benefit is that it's always invoked no matter how/where I leave scope.

So I implemented something similar in Perl but it seems there'd be an easier way. Comments critiques welcome.

The way I did it in Perl:

• create a global, tied variable which holds an array of subs to be executed.
• whenever I want to schedule a fn to be invoked on exit, I use local to change the array. when I leave the current scope, Perl changes the global to the previous value because the global is tied, I know when this value change happens and can invoke the subs in the list.

The actual code is below.

Is there a better way to do this? Seems this would be a commonly needed capability.

use strict;

package tiescalar;

sub TIESCALAR {
    my $class = shift;

    my $self = {};
    bless $self, $class;
    return $self;
}

sub FETCH {
    my $self = shift;
    return $self->{VAL};
}

sub STORE {
    my $self = shift;
    my $value = shift;

    if (defined($self->{VAL}) && defined($value)) {
    foreach my $s (@{$self->{VAL}}) { &$s; }
    }
    $self->{VAL} = $value;
}

1;

package main;

our $h;
tie($h, 'tiescalar');
$h = [];
printf "1\n";
printf "2\n";

sub main { 
    printf "3\n";
    local $h = [sub{printf "9\n"}];
    push(@$h, sub {printf "10\n";});
    printf "4\n";
    { 
    local $h = [sub {printf "8\n"; }];
    mysub();
    printf "7\n";
    return;
    }
}

sub mysub {
    local $h = [sub {printf "6\n"; }];
    print "5\n";
}

main();

printf "11\n";

Answer 1

Well, your specific case is already handled if you use lexical filehandles (as opposed to the old style bareword filehandles). For other cases, you could always use the DESTROY method of an object guaranteed to go to zero references when it goes out of scope:

#!/usr/bin/perl

use strict;
use warnings;

for my $i (1 .. 5) {
    my $defer = Defer::Sub->new(sub { print "end\n" });
    print "start\n$i\n";
}

package Defer::Sub;

use Carp;

sub new {
    my $class = shift;
    croak "$class requires a function to call\n" unless @_;
    my $self  = {
        func => shift,
    };
    return bless $self, $class;
}

sub DESTROY { 
    my $self = shift;
    $self->{func}();
}

ETA: I like brian's name better, Scope::OnExit is a much more descriptive name.