File Coverage

blib/lib/Eval/TypeTiny/CodeAccumulator.pm

Criterion	Covered	Total	%
statement	73	75	97.3
branch	6	10	60.0
condition	5	10	50.0
subroutine	20	20	100.0
pod	14	14	100.0
total	118	129	91.4

package Eval::TypeTiny::CodeAccumulator;

use 5.008001;
use strict;
use warnings;

BEGIN {
	if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat }
}

BEGIN {
	$Eval::TypeTiny::CodeAccumulator::AUTHORITY  = 'cpan:TOBYINK';
	$Eval::TypeTiny::CodeAccumulator::VERSION    = '2.010001';
}

$Eval::TypeTiny::CodeAccumulator::VERSION =~ tr/_//d;

sub new {
	my $class = shift;

	my %self  = @_ == 1 ? %{$_[0]} : @_;
	$self{env}          ||= {};
	$self{code}         ||= [];
	$self{placeholders} ||= {};
	$self{indent}       ||= '';

	bless \%self, $class;
}

sub code        { join( "\n", @{ $_[0]{code} } ) }
sub description { $_[0]{description} }
sub env         { $_[0]{env} }

sub add_line {
	my $self = shift;
	my $indent = $self->{indent};

	push @{ $self->{code} }, map { $indent . $_ } map { split /\n/ } @_;

	$self;
}

sub addf {
	my $self = shift;
	my $fmt  = shift;
	$self->add_line( sprintf $fmt, @_ );
}

sub increase_indent {
	$_[0]{indent} .= "\t";
	$_[0];
}

sub decrease_indent {
	$_[0]{indent} =~ s/\t$//;
	$_[0];
}

sub add_gap {
	push @{ $_[0]{code} }, '';
}

sub add_placeholder {
	my ( $self, $for ) = ( shift, @_ );
	my $indent = $self->{indent} || '';

	$self->{placeholders}{$for} = [
		scalar( @{ $self->{code} } ),
		$self->{indent},
	];
	push @{ $self->{code} }, "$indent# placeholder [ $for ]";

	if ( defined wantarray ) {
		return sub { $self->fill_placeholder( $for, @_ ) };
	}
}

sub fill_placeholder {
	my ( $self, $for, @lines ) = ( shift, @_ );

	my ( $line_number, $indent ) = @{ delete $self->{placeholders}{$for} or die };
	my @indented_lines = map { $indent . $_ } map { split /\n/ } @lines;
	splice( @{ $self->{code} }, $line_number, 1, @indented_lines );

	$self;
}

sub add_variable {
	my ( $self, $suggested_name, $reference ) = ( shift, @_ );

	my $actual_name = $suggested_name;
	my $i = 1;
	while ( exists $self->{env}{$actual_name} ) {
		$actual_name = sprintf '%s_%d', $suggested_name, ++$i;
	}

	$self->{env}{$actual_name} = $reference;

	$actual_name;
}

sub finalize {
	my $self = shift;

	for my $p ( values %{ $self->{placeholders} } ) {
		splice( @{ $self->{code} }, $p->[0], 1 );
	}

	$self;
}

sub compile {
	my ( $self, %opts ) = ( shift, @_ );

	$self->{finalized}++ or $self->finalize();

	require Eval::TypeTiny;
	return Eval::TypeTiny::eval_closure(
		description  => $self->description,
		%opts,
		source       => $self->code,
		environment  => $self->env,
	);
}

1;

__END__