use v5.12;
use PPI;
use Perl::Critic::Utils;
use Acme::MetaSyntactic;

my $meta = "Acme::MetaSyntactic"->new("haddock");

my $input = <<'CODE';
use Foo qw(imported_func);

sub announce {
    my $val = shift @_;
    print "$val\n";
}

my @list = qw( foo bar baz );
for my $i (0 .. $#list) {
    my $value = imported_func($list[$i]);
    announce($value) if __PACKAGE__->can("announce");
}
CODE

my $doc = "PPI::Document"->new(\$input);
my (%names, %localsub);

for my $word (@{ $doc->find("PPI::Token::Word")||[] })
{
    if ($word->sprevious_sibling eq "sub")
    {
        $localsub{$word}++;
    }
}

for my $word (@{ $doc->find("PPI::Token::Word")||[] })
{
    my $case =
        ($word eq uc $word) ? sub { uc $_[0] } :
        ($word eq lc $word) ? sub { lc $_[0] } : sub { $_[0] };
    
    if (Perl::Critic::Utils::is_perl_builtin($word))
    {
        next;
    }
    elsif ($word->sprevious_sibling eq "sub" and $localsub{$word})
    {
        $word->set_content($names{$word} ||= $case->($meta->name));
    }
    elsif (Perl::Critic::Utils::is_function_call($word) and $localsub{
+$word})
    {
        $word->set_content($names{$word} ||= $case->($meta->name));
    }
}

for my $word (@{ $doc->find(sub { $_[1]->isa("PPI::Token::Symbol") or 
+$_[1]->isa("PPI::Token::ArrayIndex") })||[] })
{
    next if $word->isa("PPI::Token::Magic");
    
    my $case =
        ($word eq uc $word) ? sub { uc $_[0] } :
        ($word eq lc $word) ? sub { lc $_[0] } : sub { $_[0] };
    
    (my $sigil = "$word") =~ s/(\w.*)$//g;
    my $rest = $1;
    
    if ($word->isa("PPI::Token::Symbol"))
    {
        $names{$word->symbol} ||= $case->($meta->name);
        $word->set_content($sigil . $names{$word->symbol});
    }
    else
    {
        $names{"\@$rest"} ||= $case->($meta->name);
        $word->set_content($sigil . $names{"\@$rest"});
    }
}

for my $qq (@{ $doc->find(sub { $_[1]->isa("PPI::Token::Quote::Double"
+) or $_[1]->isa("PPI::Token::Quote::Interpolate") })||[] })
{
    my $txt = "$qq";
    
    if ($localsub{$qq->string})
    {
        $txt =~ s/${\quotemeta($qq->string)}/$names{$qq->string}/eg;
    }
    else
    {
        $txt =~ s/([\$\@]\w+)/$names{$1}?substr($1,0,1).$names{$1}:$1/
+eg;
    }
    
    $qq->set_content($txt);
}

print $doc;

__END__
use Foo qw(imported_func);

sub cry_babies {
    my $numbskulls = shift @_;
    print "$numbskulls\n";
}

my @two_timing_troglodytes = qw( foo bar baz );
for my $cheat (0 .. $#two_timing_troglodytes) {
    my $gyroscope = imported_func($two_timing_troglodytes[$cheat]);
    cry_babies($gyroscope) if __PACKAGE__->can("cry_babies");
}
[download]

(Updated to add support for tracking locally defined versus imported functions; and ->can support.)

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.