File Coverage

blib/lib/PPIx/Regexp/Structure/Quantifier.pm
Criterion Covered Total %
statement 65 69 94.2
branch 36 48 75.0
condition 11 15 73.3
subroutine 12 15 80.0
pod 4 4 100.0
total 128 151 84.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PPIx::Regexp::Structure::Quantifier - Represent curly bracket quantifiers
4              
5             =head1 SYNOPSIS
6              
7             use PPIx::Regexp::Dumper;
8             PPIx::Regexp::Dumper->new( 'qr{fo{2,}}smx' )
9             ->print();
10              
11             =head1 INHERITANCE
12              
13             C is a
14             L.
15              
16             C has no descendants.
17              
18             =head1 DESCRIPTION
19              
20             This class represents curly bracket quantifiers such as C<{3}>, C<{3,}>
21             and C<{3,5}>. The contents are left as literals or interpolations.
22              
23             B that if they occur inside a variable-length look-behind,
24             quantifiers with different low and high limits (such as C<'{1,3}'> imply
25             a minimum Perl version of C<5.29.9>. Quantifiers specifying more than
26             255 characters are regarded as parse errors and reblessed into the
27             unknown structure.
28              
29             =head1 METHODS
30              
31             This class provides no public methods beyond those provided by its
32             superclass.
33              
34             =cut
35              
36             package PPIx::Regexp::Structure::Quantifier;
37              
38 9     9   66 use strict;
  9         17  
  9         244  
39 9     9   44 use warnings;
  9         20  
  9         235  
40              
41 9     9   51 use base qw{ PPIx::Regexp::Structure };
  9         19  
  9         806  
42              
43 9     9   58 use Scalar::Util qw{ looks_like_number };
  9         16  
  9         518  
44              
45 9         9941 use PPIx::Regexp::Constant qw{
46             INFINITY
47             LITERAL_LEFT_CURLY_ALLOWED
48             MINIMUM_PERL
49             MSG_LOOK_BEHIND_TOO_LONG
50             STRUCTURE_UNKNOWN
51             VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED
52             @CARP_NOT
53 9     9   56 };
  9         20  
54              
55             our $VERSION = '0.087_01';
56              
57             sub can_be_quantified {
58 0     0 1 0 return;
59             }
60              
61             sub explain {
62 4     4 1 12 my ( $self ) = @_;
63              
64             =begin comment
65              
66             my $content = $self->content();
67             if ( $content =~ m/ \A [{] ( .*? ) [}] \z /smx ) {
68             my $quant = $1;
69             my ( $lo, $hi ) = split qr{ , }smx, $quant;
70             foreach ( $lo, $hi ) {
71             defined
72             or next;
73             s/ \A \s+ //smx;
74             s/ \s+ \z //smx;
75             }
76             defined $lo
77             and '' ne $lo
78             or $lo = '0';
79             defined $hi
80             and '' ne $hi
81             and return "match $lo to $hi times";
82             $quant =~ m/ , \z /smx
83             and return "match $lo or more times";
84             $lo =~ m/ [^0-9] /smx
85             and return "match $lo times";
86             return "match exactly $lo times";
87             }
88             return $self->SUPER::explain();
89              
90             =end comment
91              
92             =cut
93              
94 4         11 my ( $lo, $hi ) = $self->_min_max();
95              
96 4 100       22 if ( looks_like_number( $hi ) ) {
    50          
97 3 100       17 $hi == INFINITY
98             and return "match $lo or more times";
99 2 100 66     18 looks_like_number( $lo )
100             and $lo == $hi
101             and return "match exactly $lo times";
102             } elsif ( $lo eq $hi ) {
103 1         6 return "match $lo times";
104             }
105 1         5 return "match $lo to $hi times";
106             }
107              
108             sub _min_max {
109 39     39   78 my ( $self ) = @_;
110 39         106 my $content = $self->content();
111 39 50       399 if ( $content =~ m/ \A [{] ( .*? ) [}] \z /smx ) {
112 39         124 my $quant = $1;
113 39         280 my ( $lo, $hi ) = split qr{ , }smx, $quant;
114 39         144 foreach ( $lo, $hi ) {
115             defined
116 78 100       201 or next;
117 71         167 s/ \A \s+ //smx;
118 71         171 s/ \s+ \z //smx;
119             }
120 39 100 66     186 defined $lo
121             and '' ne $lo
122             or $lo = 0;
123 39 100 100     206 defined $hi
124             and '' ne $hi
125             and return ( $lo, $hi );
126 13 100       60 $quant =~ m/ , \z /smx
127             and return ( $lo, INFINITY );
128 7         32 return ( $lo, $lo );
129             }
130             }
131              
132             sub is_quantifier {
133 0     0 1 0 return 1;
134             }
135              
136             sub width {
137 35     35 1 87 return ( 0, 0 );
138             }
139              
140             sub __quantified_width {
141 35     35   92 my ( $self, $raw_min, $raw_max ) = @_;
142 35         103 my ( $my_min, $my_max ) = $self->_min_max();
143 35         92 foreach ( $my_min, $my_max ) {
144 70 100       228 looks_like_number( $_ )
145             or $_ = undef;
146             }
147 35 50       133 defined $raw_min
    50          
148             and $raw_min = defined $my_min ? $raw_min * $my_min : undef;
149 35 100       119 defined $raw_max
    50          
150             and $raw_max = defined $my_max ? $raw_max * $my_max : undef;
151 35         143 return ( $raw_min, $raw_max );
152             }
153              
154             sub __following_literal_left_curly_disallowed_in {
155 0     0   0 return LITERAL_LEFT_CURLY_ALLOWED;
156             }
157              
158             sub _too_big {
159 1     1   7 my ( $self ) = @_;
160 1         17 STRUCTURE_UNKNOWN->__PPIX_ELEM__rebless( $self,
161             error => MSG_LOOK_BEHIND_TOO_LONG,
162             );
163 1         6 return 1;
164             }
165              
166             sub __PPIX_LEXER__finalize {
167 29     29   81 my ( $self ) = @_;
168              
169 29         131 my $content = $self->content();
170              
171 29 100       232 if ( $self->__in_look_behind() ) {
172 2 50       19 if ( $content =~ m/ \A [{] ( .*? ) [}] \z /smx ) {
173 2         9 my $quant = $1;
174              
175 2 100       29 $quant =~ m/ , \z /smx
176             and return $self->_too_big();
177              
178 1         8 my ( $lo, $hi ) = split qr{ , }smx, $quant;
179              
180 1 50       5 defined $hi
181             or $hi = $lo;
182              
183 1         7 my $numeric = 1;
184 1         3 foreach ( $lo, $hi ) {
185 2 50       10 if ( m/ \A [0-9]+ \z /smx ) {
186 2 50       10 $_ >= 256
187             and return $self->_too_big();
188             } else {
189 0         0 $numeric = 0;
190             }
191             }
192              
193 1 50 33     7 if ( $numeric && $lo != $hi ) {
194              
195 1 50       22 if ( my $finish = $self->finish() ) {
196             $finish->perl_version_introduced() lt
197             VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED
198             and $finish->{perl_version_introduced} =
199 1 50       5 VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED;
200             }
201              
202             }
203             }
204             }
205              
206             ( $content =~ m/ \s /smx or $content =~ m/ \A \{ , /smx )
207 28 100 100     309 and $self->finish()->{perl_version_introduced} = '5.033006';
208              
209 28         85 return 0;
210             }
211              
212             # Called by the lexer to record the capture number.
213             sub __PPIX_LEXER__record_capture_number {
214 28     28   118 my ( undef, $number ) = @_; # Invocant unused
215 28         86 return $number;
216             }
217              
218             1;
219              
220             __END__