#!/usr/bin/env perl
=head1 Abstract

p5find-sub is a program to find subroutine definitions in your perl5 code.
When invoked, it simply prints the location all subroutines, including the
name-less ones.

=head1 Examples

Here is a partial result for perlbrew repository:

    > p5find-sub lib | head
    lib/App/Perlbrew/Path/Installation.pm:11:sub name {
    lib/App/Perlbrew/Path/Installation.pm:15:sub bin {
    lib/App/Perlbrew/Path/Installation.pm:19:sub man {
    lib/App/Perlbrew/Path/Installation.pm:23:sub perl {
    lib/App/Perlbrew/Path/Installation.pm:27:sub version_file {
    lib/App/Perlbrew/Path/Installations.pm:12:sub child {
    lib/App/Perlbrew/Path/Installations.pm:22:sub children {
    lib/App/Perlbrew/Path/Installations.pm:26:sub list {
    lib/App/Perlbrew/Path/Root.pm:12:sub bin {
    lib/App/Perlbrew/Path/Root.pm:16:sub build {

To find a subroutine by its name, pass the name with C<--name> parameter:

    > p5find-sub --name do_install_this lib
    lib/App/perlbrew.pm:1706:sub do_install_this {

=cut

use v5.18;
use warnings;
use Getopt::Long 'GetOptions';
use List::Util 'first';
use App::p5find qw<p5_doc_iterator print_file_linenum_line>;

sub print_usage {
    print <<USAGE;
p5find-sub [switches] [path1] [path2]...
  -h        show help message
  --name    specify the name of subroutine.

For more documentation, see: perldoc p5find-sub
USAGE
}

my %opts;
GetOptions(
    \%opts,
    "h",
    "name=s",
    "contains=s"
);

if ($opts{h}) {
    print_usage();
    exit(0);
}

my ($wanted_sub_name, @paths);

if ($opts{name}) {
    $wanted_sub_name = $opts{name};
}

@paths = @ARGV;
@paths = ('.') unless @paths;

my $iter = p5_doc_iterator(@paths);
while (my $doc = $iter->()) {
    my $file = $doc->filename;

    my $o = $doc->find(
        sub {
            my $el = $_[1];
            return (
                $el->isa("PPI::Token::Word") && $el eq "sub" && (
                    $el->parent->isa("PPI::Statement::Sub") ||
                    $el->snext_sibling()->isa("PPI::Structure::Block")
                )
            );
        }
    ) or next;

    my %hits;
    for my $token (@$o) {
        # $token is the word "sub"
        my $el = $token->parent;
        my $sub_name = $el->isa("PPI::Statement::Sub") ? $el->name : "(anonymous)";

        my $hit = 0;
        if ($opts{contains}) {
            if (my @tok = grep { $_->significant } $el->tokens) {
                for my $tok (@tok) {
                    if ("$tok" eq $opts{contains}) {
                        $hit = 1;
                        last;
                    }
                }
            }
        }
        elsif ( !defined($wanted_sub_name) || $wanted_sub_name eq $sub_name ) {
            $hit = 1;
        }


        if ($hit) {
            my $ln = $token->line_number;
            $hits{$ln} = 1;
        }

    }

    if (%hits) {
        print_file_linenum_line( $file, \%hits );
    }
}
