use strict;
use warnings;
use Text::Balanced qw(extract_bracketed);

my $code = "sub blah {\n {}\n {}\n {}\n {}\n}
and some other stuff
sub another {\n}";

for my $end (find_ends($code)) {
    $code = substr($code, 0, $end)
          . "}"
          . substr($code, $end);
}
$code =~ s/sub/{sub/g;

print "$code\n";

sub find_ends {
    local $_ = $_[0];

    my @ends;
    while (/(sub\s+\S+\s*)(?={)/g) {
        () = extract_bracketed($_, '{}');
        push @ends, pos;
    }

    return @ends;
}

##</code><code>##

sub find_ends {
    local $_ = $_[0];

    my @ends;
    while (/(sub\s+\S+\s*{[^}]*})/g) {
        my $sub = $1;

        my $end;
        while ($sub) {
            my $open  = $sub =~ tr/{/{/;
            my $close = $sub =~ tr/}/}/;

            if ($open > $close and /\G([^}]*})/g) {
                $sub .= $1;
                $end = $+[0];
            } else {
                $end = $+[0];
                last;
            }
        }

        push @ends, $end;
    }

    return @ends;
}

##</code><code>##

Benchmark: running rd, tb for at least 10 CPU seconds...
        rd:  9 wallclock secs (10.36 usr +  0.01 sys = 10.37 CPU) @ 29908.68/s (n=310153)
        tb: 11 wallclock secs (10.55 usr +  0.01 sys = 10.56 CPU) @ 5602.84/s (n=59166)
      Rate   tb   rd
tb  5603/s   -- -81%
rd 29909/s 434%   --