view release on metacpan or  search on metacpan

lib/Acme/PPIx/MetaSyntactic.pm  view on Meta::CPAN

	my $name = $self->theme->name;
	my $i    = undef;
	my $used = $self->already_used;
	$i++ while $used->{"$name$i"};
	$used->{"$name$i"} = 1;
	return "$name$i";
}

sub _build_theme
{
	my $self = shift;
	"haddock";
}

sub _build_local_subs
{
	my $self = shift;
	my %r;
	
	for my $word (@{ $self->document->find("PPI::Token::Word") || [] })
	{
		$r{$word} = 1 if $word->sprevious_sibling eq "sub";
		$r{$word} = 1 if $word->sprevious_sibling eq "constant" && $word->sprevious_sibling->sprevious_sibling eq "use";
	}
	
	return \%r;
}

sub _build_names
{
	my $self = shift;
	return +{};
}

sub _build_already_used
{
	my $self = shift;
	return +{
		map +($_, 1), values %{ $self->names },
	};
}

sub BUILD
{
	my $self = shift;
	$self->_relabel_subs;
	$self->_relabel_variables;
	return;
}

sub _relabel_subs
{
	my $self = shift;
	my $ls   = $self->local_subs;
	my $n    = $self->names;
	
	for my $word (@{ $self->document->find("PPI::Token::Word")||[] })
	{
		next if is_perl_builtin($word);
		
		# Function to preserve original case of variable.
		my $case =
			($word eq uc $word) ? sub { uc $_[0] } :
			($word eq lc $word) ? sub { lc $_[0] } : sub { $_[0] };
		
		if ($word->sprevious_sibling eq "sub" and $ls->{$word})
		{
			$word->set_content($n->{$word} ||= $case->($self->_get_name));
		}
		elsif ($word->sprevious_sibling eq "constant" && $word->sprevious_sibling->sprevious_sibling eq "use" and $ls->{$word})
		{
			$word->set_content($n->{$word} ||= $case->($self->_get_name));
		}
		elsif (is_function_call($word) and $ls->{$word})
		{
			$word->set_content($n->{$word} ||= $case->($self->_get_name));
		}
	}
	
	return;
}

sub _relabel_variables
{
	my $self = shift;
	my $ls   = $self->local_subs;
	my $n    = $self->names;
	
	my $VariableFinder = sub {
		$_[1]->isa("PPI::Token::Symbol") or $_[1]->isa("PPI::Token::ArrayIndex");
	};
	
	for my $word (@{ $self->document->find($VariableFinder) || [] })
	{
		next if $word->isa("PPI::Token::Magic");
		
		# Function to preserve original case of variable.
		my $case =
			($word eq uc $word) ? sub { uc $_[0] } :
			($word eq lc $word) ? sub { lc $_[0] } : sub { $_[0] };
		
		# Separate sigil from the rest of the variable name.
		(my $sigil = "$word") =~ s/(\w.*)$//g;
		my $rest = $1;
		
		if ($word->isa("PPI::Token::Symbol"))
		{
			$n->{$word->symbol} ||= $case->($self->_get_name);
			$word->set_content($sigil . $n->{$word->symbol});
		}
		elsif ($word->isa("PPI::Token::ArrayIndex"))  # like $#foo
		{
			$n->{"\@$rest"} ||= $case->($self->_get_name);
			$word->set_content($sigil . $n->{"\@$rest"});
		}
	}
	
	for my $qq (@{ $self->document->find("PPI::Token::Quote") || [] })
	{
		# A string that "co-incidentally" happens to have the name as a locally
		# defined sub. This might be a __PACKAGE__->can("foo"), so change it!
		# 
		if ($ls->{$qq->string})
		{
			my $txt = "$qq";
			$txt =~ s/${\quotemeta($qq->string)}/$n->{$qq->string}/eg;
			$qq->set_content($txt);
		}
		
		# An interpolated string. We'll do our best to find any variables
		# within it and rename them, but PPI doesn't really look inside
		# interpolated strings (yet?).
		# 
		elsif ($qq->isa("PPI::Token::Quote::Double") or $qq->isa("PPI::Token::Quote::Interpolate"))
		{
			my $txt = "$qq";
			$txt =~ s/([\$\@]\w+)/$n->{$1}?substr($1,0,1).$n->{$1}:$1/eg;
			$qq->set_content($txt);
		}
	}
}

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Acme::PPIx::MetaSyntactic - rename functions and variables in a PPI::Document using Acme::MetaSyntactic

=head1 SYNOPSIS

 my $acme = "Acme::PPIx::MetaSyntactic"->new(document => \<<'END');