POD in 5 Minutes

Why are you writing your own solution before searching for predictable tools already built? Get into the habit of using google.com, search.cpan.org, perlmonks.org super-search... before you start coding.

There's also a common saying, Nothing can parse Perl except perl. Trying to parse a few constrained varieties of Perl code with a few regular expressions will be an infinite task, chasing parse bugs and finding new valid syntax.

--
[ e d @ h a l l e y . c c ]

    if ($content =~ /^sub\s+(\w+)[^#]*(?:#(.*))?$/) {
        print "Subname: $1\n";
        print "Comment: $2\n" if defined $2;
    }
[download]

Note that it will fail to catch subs with attributes, or subs with a fully qualified name.

Abigail

Erm, perhaps perldoc perlpod or perltidy would be helpful?

if ($content =~ /^(sub\s+\w+)[^#]*(#.*)?/) {
   print "$1\n";
   print "$2\n" if ($2);
}
[download]

@parsed receives the captured matches. The captured matches will be the sub portion, followed by either the comment or nothing (using alternation, grouped by non-matching parens).

my @parsed;
if ( @parsed = $content =~
    /^\s*(sub\s+\w+).+?(?:(#.+)|())$/ )
        {
            local $, = "\n";
            print @parsed;
        }
[download]

Dave

"If I had my life to do over again, I'd be a plumber." -- Albert Einstein

Just for kicks here's my attempt at handling fully qualified names (including archaic forms), prototypes, and attributes.

#! perl -slw
use strict;
use re 'eval';

my $re_sub = qr[
    sub\s+
    (
        (?: (\w+)? (?: :: | ' ) )*
        \w+ \s*
    )
    (?{ $name = $^N })
    (
        (?: \( [&$@\\; ]+ \) )? \s*
    )
    (?{ $prototype = $^N || '' })
    (
        (?: : \s* \w+ (?: \( .+? \) )? \s* )*
    )
    (?{ $attributes = $^N || '' })
    \{
]x;

BEGIN{ @ARGV = map{ glob } @ARGV if $^O eq 'MSWin32'; }

our( $name, $prototype, $attributes );
local $/ = undef;
while( <> ) {
    tr[\n][];
    s[\s+][ ]g;
    printf "%-40s : Name: %-20s\tPrototype: %10s\n\tAttributes : %s\n"
+,
        $ARGV, $name, $prototype, $attributes
        while m[$re_sub]g;
}
[download]

It's quite interesting to run this against the files in your libpath.

Of course this doesn't respect comments or pod boundaries.