view release on metacpan or  search on metacpan

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

package Acme::PPIx::MetaSyntactic;

use Moo 2;
no warnings qw(uninitialized once numeric);

BEGIN {
	$Acme::PPIx::MetaSyntactic::AUTHORITY = 'cpan:TOBYINK';
	$Acme::PPIx::MetaSyntactic::VERSION   = '0.004';
}

use Acme::MetaSyntactic;
use PPIx::Utils qw( is_perl_builtin is_function_call );
use PPI;

use Types::Standard -types;

my $Document      = (InstanceOf["PPI::Document"])->plus_coercions(
	ScalarRef[Str], q { "PPI::Document"->new($_) },
	Str,            q { "PPI::Document"->new($_) },
	FileHandle,     q { do { local $/; my $c = <$_>; "PPI::Document"->new(\$c) } },
	ArrayRef[Str],  q { do { my $c = join "\n", map { chomp(my $l = $_); $l } @$_; "PPI::Document"->new(\$c) } },
);

my $MetaSyntactic = (InstanceOf["Acme::MetaSyntactic"])->plus_coercions(
	Str,            q { "Acme::MetaSyntactic"->new($_) },
);

my $TruthTable    = (Map[Str, Bool])->plus_coercions(
	ArrayRef[Str],  q { +{ map +($_, 1), @$_ } },
);

has document => (
	is       => "ro",
	isa      => $Document,
	coerce   => 1,
	required => 1,
);

has theme => (
	is       => "lazy",
	isa      => $MetaSyntactic,
	coerce   => 1,
);

has local_subs => (
	is       => "lazy",
	isa      => $TruthTable,
	coerce   => 1,
);

has names => (
	is       => "lazy",
	isa      => Map[Str, Str],
);

has already_used => (
	is       => "lazy",
	isa      => $TruthTable,
	coerce   => 1,
	init_arg => undef,
);

sub _get_name
{
	my $self = shift;
	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 =