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


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PPIx::Regexp::Structure::Assertion - Represent a parenthesized assertion
4              
5             =head1 SYNOPSIS
6              
7             use PPIx::Regexp::Dumper;
8             PPIx::Regexp::Dumper->new( 'qr{(?<=foo)bar}smx' )
9             ->print();
10              
11             =head1 INHERITANCE
12              
13             C<PPIx::Regexp::Structure::Assertion> is a
14             L<PPIx::Regexp::Structure|PPIx::Regexp::Structure>.
15              
16             C<PPIx::Regexp::Structure::Assertion> has no descendants.
17              
18             =head1 DESCRIPTION
19              
20             This class represents one of the parenthesized assertions, either look
21             ahead or look behind, and either positive or negative.
22              
23             =head1 METHODS
24              
25             This class provides the following public methods beyond those provided
26             by its superclass.
27              
28             =cut
29              
30             package PPIx::Regexp::Structure::Assertion;
31              
32 9     9   51 use strict;
  9         15  
  9         308  
33 9     9   33 use warnings;
  9         12  
  9         406  
34              
35 9     9   37 use base qw{ PPIx::Regexp::Structure };
  9         12  
  9         719  
36              
37 9     9   48 use Carp qw{ confess };
  9         13  
  9         512  
38 9     9   41 use List::Util qw{ max };
  9         24  
  9         617  
39              
40             our $VERSION = '0.091';
41              
42 9         3444 use PPIx::Regexp::Constant qw{
43             LITERAL_LEFT_CURLY_ALLOWED
44             VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED
45             @CARP_NOT
46 9     9   46 };
  9         13  
47              
48             =head2 is_look_ahead
49              
50             This method returns a true value if the assertion is a look-ahead
51             assertion, or a false value if it is a look-behind assertion.
52              
53             =cut
54              
55             sub is_look_ahead {
56 17     17 1 35 my ( $self ) = @_;
57 17         43 return $self->_get_type()->is_look_ahead();
58             }
59              
60             =head2 is_positive
61              
62             This method returns a true value if the assertion is a positive
63             assertion, or a false value if it is a negative assertion.
64              
65             =cut
66              
67             sub is_positive {
68 0     0 1 0 my ( $self ) = @_;
69 0         0 return $self->_get_type()->is_positive();
70             }
71              
72             sub perl_version_introduced {
73 13     13 1 32 my ( $self ) = @_;
74             return( $self->{perl_version_introduced} ||=
75 13   33     78 $self->_perl_version_introduced() );
76             }
77              
78             sub _perl_version_introduced {
79 13     13   50 my ( $self ) = @_;
80 13         28 my $ver = max( map { $_->perl_version_introduced() }
  29         86  
81             $self->children() );
82 13 100 100     67 if ( $ver < VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED &&
83             ! $self->is_look_ahead()
84             ) {
85 2         12 my ( $wid_min, $wid_max ) = $self->raw_width();
86 2 50 66     11 defined $wid_min
      66        
87             and defined $wid_max
88             and $wid_min < $wid_max
89             and $ver = max( $ver, VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED );
90             }
91 13         50 return $ver;
92             }
93              
94             sub width {
95 5     5 1 8 return ( 0, 0 );
96             }
97              
98             # An un-escaped literal left curly bracket can always follow this
99             # element.
100             sub __following_literal_left_curly_disallowed_in {
101 1     1   4 return LITERAL_LEFT_CURLY_ALLOWED;
102             }
103              
104             sub _get_type {
105 17     17   30 my ( $self ) = @_;
106 17 50       57 my $type = $self->type()
107             or confess 'Programming error - no type object';
108 17 50       55 $type->isa( 'PPIx::Regexp::Token::GroupType::Assertion' )
109             or confess 'Programming error - type object is ', ref $type,
110             ' not PPIx::Regexp::Token::GroupType::Assertion';
111 17         54 return $type;
112             }
113              
114             1;
115              
116             __END__
117              
118             =head1 SUPPORT
119              
120             Support is by the author. Please file bug reports at
121             L<https://rt.cpan.org/Public/Dist/Display.html?Name=PPIx-Regexp>,
122             L<https://github.com/trwyant/perl-PPIx-Regexp/issues>, or in
123             electronic mail to the author.
124              
125             =head1 AUTHOR
126              
127             Thomas R. Wyant, III F<wyant at cpan dot org>
128              
129             =head1 COPYRIGHT AND LICENSE
130              
131             Copyright (C) 2009-2023, 2025 by Thomas R. Wyant, III
132              
133             This program is free software; you can redistribute it and/or modify it
134             under the same terms as Perl 5.10.0. For more details, see the full text
135             of the licenses in the directory LICENSES.
136              
137             This program is distributed in the hope that it will be useful, but
138             without any warranty; without even the implied warranty of
139             merchantability or fitness for a particular purpose.
140              
141             =cut
142              
143             # ex: set textwidth=72 :