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
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|