File Coverage

blib/lib/PPIx/QuoteLike/Token/Interpolation.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	12	14	85.7
condition	5	15	33.3
subroutine	11	11	100.0
pod	2	2	100.0
total	78	90	86.6

package PPIx::QuoteLike::Token::Interpolation;

use 5.006;

use strict;
use warnings;

use Carp;
use PPI::Document;
use PPIx::QuoteLike::Constant qw{
    LOCATION_COLUMN
    LOCATION_LOGICAL_LINE
    LOCATION_LOGICAL_FILE
    @CARP_NOT
};
use PPIx::QuoteLike::Utils qw{
    __normalize_interpolation_for_ppi
    __variables
};

use base qw{ PPIx::QuoteLike::Token };

our $VERSION = '0.022_01';

sub ppi {
    my ( $self ) = @_;
    unless ( $self->{ppi} ) {
	my $content;
	my $location = $self->{location};
	if ( $location ) {
	    my $fn;
	    if( defined( $fn = $location->[LOCATION_LOGICAL_FILE] ) ) {
		$fn =~ s/ (?= [\\"] ) /\\/smxg;
		$content = qq{#line $location->[LOCATION_LOGICAL_LINE] "$fn"\n};
	    } else {
		$content = qq{#line $location->[LOCATION_LOGICAL_LINE]\n};
	    }
	    $content .= ' ' x ( $location->[LOCATION_COLUMN] - 1 );
	}

	$content .= __normalize_interpolation_for_ppi( $self->content() );

	$self->{ppi} = PPI::Document->new( \$content );

	if ( $location ) {
	    # Generate locations now.
	    $self->{ppi}->location();
	    # Remove the stuff we originally injected. NOTE that we can
	    # only get away with doing this if the removal does not
	    # invalidate the locations of the other tokens that we just
	    # generated.
	    my $elem;
	    # Remove the '#line' directive if we find it
	    $elem = $self->{ppi}->child( 0 )
		and $elem->isa( 'PPI::Token::Comment' )
		and $elem->content() =~ m/ \A \#line\b /smx
		and $elem->remove();
	    # Remove the white space if we find it, and if it in fact
	    # represents only the white space we injected to get the
	    # column numbers right.
	    my $wid = $location->[LOCATION_COLUMN] - 1;
	    $wid
		and $elem = $self->{ppi}->child( 0 )
		and $elem->isa( 'PPI::Token::Whitespace' )
		and $wid == length $elem->content()
		and $elem->remove();
	}
    }
    return $self->{ppi};
}

sub variables {
    my ( $self ) = @_;
    return __variables( $self->ppi() );
}

sub __perl_version_introduced {
    my ( $self ) = @_;
    $self->{postderef}
	and return '5.019005';
    return;
}

1;

__END__