'extract' subs from source code

[ceo]

Hello Perlmonks, I seek your great wisdom! I need to extract the code and the names of subs from scripts. So I searched CPAN, but when I found nothing, I wrote this quickly:

$moduleText = shift;

my %subs = ();
my @splitted = split(/([\{\}])/, $moduleText);
my %subPrototypes = ();
my $brackets = 0;
my $pos = 0;
while ($pos <= $#splitted) {
    if($splitted[$pos] =~ /sub (.+?)\s{1,}(\(.+?\)){0,1}\s*/) {
        $pos += 1;
        my $this_sub = $1;
        $subPrototypes{$this_sub} = $2 if $2;
        while ($pos <= $#splitted) {
            if($splitted[$pos]) {
                $brackets++ if($splitted[$pos] eq "{");
                $brackets-- if($splitted[$pos] eq "}");
            }
            $subs{$this_sub} .= $splitted[$pos];
            if($brackets <= 0) {
                last;
            }
            $pos++;
        }
    } else {
        $pos++;
    }
}

And it works OK in most situations. But there are some special situations like in strings (" and ' could easily been done, but q and qq and ... are really hard to realize) and so on, where you can put opening and closing brackets without effect to the logic of the script itself. So... as I know: Only perl can parse Perl, but ain't there really any other way to do that? Maybe someone has an idea? Any help would be greatly appreciated!

[toolic]

From reorder subroutines in a perl file.:

PPI - Parse, Analyze and Manipulate Perl (without perl)

Here is an example which can get you started: How can I write a Perl script to extract the source code of each subroutine in a Perl package?

[2teez]

try this:

use warnings;
use strict;

while(<ARGV>){
   chomp;
   print $1,$/ if/^sub\s+?(.+?){/; ## print subroutine name
   if(/^sub\s+?/.. /^}/){          
      print $_,$/;
    }
}

it works for me.
UPDATE:
The code above, is based on the assumption that:

1. the OP's script(s) start every sub on a new line,
2. the OP's script(s) and question does not cover anonymous subroutine
However, if these are not so, then all that is needed is to modify the REs used like so:

    ...
    chomp;
    print $1, $/ if /^(?:.+)?\bsub\s+?(.+?){/; ## assumption still her
+e
    if ( /^(.+)?\bsub\s+?(.+?)?{/s .. /^(.+)?}/s ) {  ## anonymous sub
+ included
        print $_, $/;
    }
   ...

Please, it should also be noted that the above may not take care of all subroutrine declaration in perl script.
rovf thanks for the eagle eye ::)

[rovf]

Hmmmm.... your solution would at best find those where the word sub occurs at the beginning of the line.

[Anonymous Monk]

Improve your search skills, maybe use MetaCPAN, parse perl -> PPI

http://deps.cpantesters.org/depended-on-by.pl?dist=PPI-1.215

Perl::Tags - Generate (possibly exuberant) Ctags style tags for Perl sourcecode

App::Grepl - Use PPI to search through Perl documents.

module_info

[tobyink]

So let's use perl to parse Perl...

use v5.10;
use strict;
use warnings;

{
    package SubLister;
    use Class::Inspector;
    sub list_subs {
        my $number = int rand 999_999_999;
        our @SUBS = ();
        eval qq{
                package Random$number;
            }.shift.q{
            BEGIN {
                @SubLister::SUBS = @{Class::Inspector->functions(__PAC
+KAGE__)};
                die;
            }
        };
        return @SUBS;
    }
}

my $source_code = <<'SRC';
sub foo { 1 }
sub bar { 2 }
sub baz { 3 }
CORE::say("We don't want to execute this!");
SRC

say("Got: $_") for SubLister::list_subs($source_code);

[NetWallah]

This is just an idea - not a real solution - but hopefully, more knowledgeable monks can either comment on it's viability, or explain it's unsuitability:

Since sub names are in the "main" namespace, how about using the perl debugger to load and print the sub info, without actually executing the program ?

[chromatic]

Since sub names are in the "main" namespace...

They probably are, but they might not be.

... without actually executing the program?

use or BEGIN or other metaprogramming mechanisms may modify what's available. You'll probably be fine with most scripts, but that's no guarantee.