# critical region - only one code BLOCK runs at any one time
sub lock_section (&@) {
    my ($cb, $old_file, $new_file, $next_file, $retry_cnt, $wait_time)
+ = @_;

    defined($old_file) && defined($new_file)
        or die("lock_section(): Must define lock filenames as argument
+s");

    # revert to old file if next file is not defined
    $next_file = $old_file unless defined($next_file);

    # set default wait
    $retry_cnt = -1 unless defined($retry_cnt); # -1 means never give 
+up
    $wait_time = 10 unless defined($wait_time) && $wait_time > 0; # 10
+us before trying again

    require Time::HiRes;

    my $rename = sub { ! -e $_[1] && rename($_[0], $_[1]) && -e $_[1] 
+};

    # wait to acquire lock
    my $i = -1;
    while (! $rename->($old_file, $new_file))
    {
        if (++$i >= $retry_cnt
                 && $retry_cnt >= 0)
        {
            my $total_wait = $i * $wait_time * 1e-6;
            warn(<<"EOT");
lock_section(): Cannot re-acquire lock - giving up after $total_wait s
+econd(s)
EOT
            return ();
        }

        Time::HiRes::usleep($wait_time);
    }

    # lock acquired
    {
        # run critical code
        my @ret = $cb->($next_file, $new_file, $old_file);

        # release lock
        $rename->($new_file, $next_file)
            or die(<<"EOT");
lock_section(): Cannot release lockfile '$new_file' as '$next_file'
EOT
        # return may potentially be obsolete at this point
        return \@ret;
    }
}
[download]