Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

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

by tobyink (Abbot)
on May 14, 2013 at 12:52 UTC ( #1033452=CUFP: print w/ replies, xml ) Need Help??

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.)

package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name

Comment on Just for fun: relabel Perl variables and function names using Acme::MetaSyntactic and PPI
Select or Download Code
Re: Just for fun: relabel Perl variables and function names using Acme::MetaSyntactic and PPI
by LanX (Canon) on May 14, 2013 at 13:35 UTC
    Can I also use PPI to auto-comment your code and get a POD like description of what it does incl. examples ? ;-)

    Cheers Rolf

    ( addicted to the Perl Programming Language)

      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.

      package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://1033452]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (7)
As of 2015-07-04 05:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (57 votes), past polls