Just for fun: relabel Perl variables and function names using Acme::MetaSyntactic and PPI

[tobyink]

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");
}

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

[LanX]

Can I also use PPI to auto-comment your code and get a POD like description of what it does incl. examples ? ;-)

[tobyink]

There is a big string called $input and the output is shown below __END__.

If you want pod, I've now uploaded a somewhat refactored and improved version to CPAN as Acme::PPIx::MetaSyntactic.