More specifically, B::Deparse's coderef2text method.

UPDATE:
My first code example would only grab the inner body of a subroutine that had NO inner blocks - not very useful. After toying with look aheads, i can up with this regex:

/sub\s+$name\s+{\s+(.*?(?=^}\s*$))/sm
[download]

You don't have to use the __DATA__ and seek trick, you could always just open the file if you need to parse other scripts or modules.

Here is the whole program. Improvements are very, very welcome :)

#!/usr/bin/perl -w

seek(DATA,0,0);

my $slurp;
{
    local $/;
    $slurp = <DATA>;
}


print_sub($slurp,'bar');

print_sub($slurp,'foo');

sub print_sub {
    my ($content,$name) = @_;
    my ($body) = $content =~ /sub\s+$name\s+{\s+(.*?(?=^}\s*$))/sm;
    print $body;
}

sub foo {
    if (1) {
        return $_[0] + 5;
    }
    else {
        return 0;
    }
    # a comment
}

sub bar {
    print "howdy";
}

__DATA__
[download]

Jeff

R-R-R--R-R-R--R-R-R--R-R-R--R-R-R--
L-L--L-L--L-L--L-L--L-L--L-L--L-L--

Two small things:

• in print_sub

  my ($body) =  $slurp =~ /sub\s+$name\s+{\s+(.*?(?=^}\s*$))/sm;
  [download]

  $slurb should be replaced by $content

  my ($body) =  $content =~ /sub\s+$name\s+{\s+(.*?(?=^}\s*$))/sm;
  [download]

  small copy and paste error ... it actually works here but just because the sub declaration and the my declaration of slurp are by chance in the same scope.

• The 'Camel' (3rd edition, chapter 5.10.3.4 - sorry no page number, this is from the bookshelf CD) has a very witty regex to match matching parens. This might also be helpful in such cases although I prefer here the suggested B::Deparse method

  $np = qr{
             \(
             (?:
                (?> [^()]+ )    # Non-parens without backtracking
              |
                (??{ $np })     # Group with matching parens
             )*
             \)
          }x;
  [download]

  [replace round parens with braces]

-- Hofmator