File Coverage

blib/lib/PPIx/Regexp/Structure/Assertion.pm

Criterion	Covered	Total	%
statement	35	37	94.5
branch	5	8	62.5
condition	8	12	66.6
subroutine	12	13	92.3
pod	4	4	100.0
total	64	74	86.4

=head1 NAME

PPIx::Regexp::Structure::Assertion - Represent a parenthesized assertion

=head1 SYNOPSIS

 use PPIx::Regexp::Dumper;
 PPIx::Regexp::Dumper->new( 'qr{(?<=foo)bar}smx' )
     ->print();

=head1 INHERITANCE

C is a
L.

C has no descendants.

=head1 DESCRIPTION

This class represents one of the parenthesized assertions, either look
ahead or look behind, and either positive or negative.

=head1 METHODS

This class provides the following public methods beyond those provided
by its superclass.

=cut

package PPIx::Regexp::Structure::Assertion;

use strict;
use warnings;

use base qw{ PPIx::Regexp::Structure };

use Carp qw{ confess };
use List::Util qw{ max };

our $VERSION = '0.087';

use PPIx::Regexp::Constant qw{
    LITERAL_LEFT_CURLY_ALLOWED
    VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED
    @CARP_NOT
};

=head2 is_look_ahead

This method returns a true value if the assertion is a look-ahead
assertion, or a false value if it is a look-behind assertion.

=cut

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

=head2 is_positive

This method returns a true value if the assertion is a positive
assertion, or a false value if it is a negative assertion.

=cut

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

sub perl_version_introduced {
    my ( $self ) = @_;
    return( $self->{perl_version_introduced} ||=
	$self->_perl_version_introduced() );
}

sub _perl_version_introduced {
    my ( $self ) = @_;
    my $ver = max( map { $_->perl_version_introduced() }
	$self->children() );
    if ( $ver < VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED &&
	!  $self->is_look_ahead()
    ) {
	my ( $wid_min, $wid_max ) = $self->raw_width();
	defined $wid_min
	    and defined $wid_max
	    and $wid_min < $wid_max
	    and $ver = max( $ver, VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED );
    }
    return $ver;
}

sub width {
    return ( 0, 0 );
}

# An un-escaped literal left curly bracket can always follow this
# element.
sub __following_literal_left_curly_disallowed_in {
    return LITERAL_LEFT_CURLY_ALLOWED;
}

sub _get_type {
    my ( $self ) = @_;
    my $type = $self->type()
	or confess 'Programming error - no type object';
    $type->isa( 'PPIx::Regexp::Token::GroupType::Assertion' )
	or confess 'Programming error - type object is ', ref $type,
	    ' not PPIx::Regexp::Token::GroupType::Assertion';
    return $type;
}

1;

__END__