File Coverage

blib/lib/PPIx/QuoteLike/Token.pm

Criterion	Covered	Total	%
statement	49	57	85.9
branch	10	16	62.5
condition	1	3	33.3
subroutine	19	21	90.4
pod	13	13	100.0
total	92	110	83.6

package PPIx::QuoteLike::Token;

use 5.006;

use strict;
use warnings;

use Carp;
use PPIx::QuoteLike::Constant qw{ MINIMUM_PERL @CARP_NOT };
use PPIx::QuoteLike::Utils qw{
    column_number
    line_number
    logical_filename
    logical_line_number
    statement
    visual_column_number
};

our $VERSION = '0.022';

# Private to this package.
sub __new {
    my ( $self, %arg ) = @_;
    defined $arg{content}
	or croak 'Content required';
    return bless \%arg, ref $self || $self;
}

sub content {
    my ( $self ) = @_;
    return $self->{content};
}

sub error {
    my ( $self ) = @_;
    return $self->{error};
}

sub location {
    my ( $self ) = @_;
    return $self->{location} ? [ @{ $self->{location} } ] : undef;
}

sub parent {
    my ( $self ) = @_;
    return $self->{parent};
}

sub next_sibling {
    my ( $self ) = @_;
    $self->{next_sibling}
	or return;
    return $self->{next_sibling};
}

sub perl_version_introduced {
    my ( $self ) = @_;
    # TODO use '//' when we can require Perl 5.10.
    defined $self->{perl_version_introduced}
	and return $self->{perl_version_introduced};
    my $vers = $self->__perl_version_introduced();
    defined $vers
	or $vers = MINIMUM_PERL;
    return ( $self->{perl_version_introduced} = $vers );
}

sub __perl_version_introduced {
    return;
}

sub perl_version_removed {
    return undef;	## no critic (ProhibitExplicitReturnUndef)
}

sub previous_sibling {
    my ( $self ) = @_;
    $self->{previous_sibling}
	or return;
    return $self->{previous_sibling};
}

sub significant {
    return 1;
}

sub snext_sibling {
    my ( $sib ) = @_;
    while ( $sib = $sib->next_sibling() ) {
	$sib->significant()
	    and return $sib;
    }
    return;
}

sub sprevious_sibling {
    my ( $sib ) = @_;
    while ( $sib = $sib->previous_sibling() ) {
	$sib->significant()
	    and return $sib;
    }
    return;
}

sub top {
    my ( $self ) = @_;
    my $kid = $self;
    while ( defined ( my $parent = $kid->parent() ) ) {
	$kid = $parent;
    }
    return $kid;
}

sub variables {
    return;
}

1;

__END__