File Coverage

blib/lib/PPIx/Regexp/Token/Delimiter.pm
Criterion Covered Total %
statement 22 22 100.0
branch 4 4 100.0
condition n/a
subroutine 8 8 100.0
pod 3 3 100.0
total 37 37 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PPIx::Regexp::Token::Delimiter - Represent the delimiters of the regular expression
4              
5             =head1 SYNOPSIS
6              
7             use PPIx::Regexp::Dumper;
8             PPIx::Regexp::Dumper->new( 'qr{foo}smx' )
9             ->print();
10              
11             =head1 INHERITANCE
12              
13             C<PPIx::Regexp::Token::Delimiter> is a
14             L<PPIx::Regexp::Token::Structure|PPIx::Regexp::Token::Structure>.
15              
16             C<PPIx::Regexp::Token::Delimiter> has no descendants.
17              
18             =head1 DESCRIPTION
19              
20             This token represents the delimiters of the regular expression. Since
21             the tokenizer has to figure out where these are anyway, this class is
22             used to give the lexer a hint about what is going on.
23              
24             =head1 METHODS
25              
26             This class provides no public methods beyond those provided by its
27             superclass.
28              
29             =cut
30              
31             package PPIx::Regexp::Token::Delimiter;
32              
33 9     9   48 use strict;
  9         15  
  9         253  
34 9     9   30 use warnings;
  9         13  
  9         384  
35              
36 9     9   36 use base qw{ PPIx::Regexp::Token::Structure };
  9         13  
  9         3882  
37              
38 9     9   54 use PPIx::Regexp::Constant qw{ MINIMUM_PERL @CARP_NOT };
  9         15  
  9         1683  
39              
40             our $VERSION = '0.091';
41              
42             # Return true if the token can be quantified, and false otherwise
43             # sub can_be_quantified { return };
44              
45             sub explain {
46 4     4 1 14 return 'Regular expression or replacement string delimiter';
47             }
48              
49             =head2 perl_version_introduced
50              
51             Experimentation with weird delimiters shows that they did not actually
52             work until Perl 5.8.3, so we return C<'5.008003'> for such delimiters.
53              
54             =cut
55              
56             sub perl_version_introduced {
57 124     124 1 781 my ( $self ) = @_;
58 124 100       233 $self->content() =~ m/ \A [[:^ascii:]] \z /smx
59             and return '5.008003';
60 119         258 return MINIMUM_PERL;
61             }
62              
63             =head2 perl_version_removed
64              
65             Perl 5.29.0 made fatal the use of non-standalone graphemes as regular
66             expression delimiters. Because non-characters and permanently unassigned
67             code points are still allowed per F<perldeprecation>, I take this to
68             mean characters that match C</\p{Mark}/> (i.e. combining diacritical
69             marks). But this regular expression does not compile under Perl 5.6.
70              
71             So:
72              
73             This method returns C<'5.029'> for such delimiters B<provided> the
74             requisite regular expression compiles. Otherwise it return C<undef>.
75              
76             =cut
77              
78             # Perl 5.29.0 disallows unassigned code points and combining code points
79             # as delimiters. Unfortunately for me non-characters and illegal
80             # characters are explicitly allowed. Still more unfortunately, these
81             # match /\p{Unassigned}/. So before I match a deprecated characer, I
82             # have to assert that the character is neither a non-character
83             # (\p{Noncharacter_code_point}) nor an illegal Unicode character
84             # (\P{Any}).
85 9         1100 use constant WEIRD_CHAR_RE => eval ## no critic (ProhibitStringyEval,RequireCheckingReturnValueOfEval)
86             'qr<
87             (?! [\p{Noncharacter_code_point}\P{Any}] )
88             [\p{Unassigned}\p{Mark}]
89 9     9   49 >smx';
  9         16  
90              
91             sub perl_version_removed {
92 127     127 1 1347 my ( $self ) = @_;
93 127 100       245 WEIRD_CHAR_RE
94             and $self->content() =~ WEIRD_CHAR_RE
95             and return '5.029';
96             # I respectfully disagree with Perl Best Practices on the
97             # following. When this method is called in list context it MUST
98             # return undef if that's the right answer, NOT an empty list.
99             # Otherwise hash constructors have the wrong number of elements.
100 126         295 return undef; ## no critic (ProhibitExplicitReturnUndef)
101             }
102              
103             1;
104              
105             __END__
106              
107             =head1 SUPPORT
108              
109             Support is by the author. Please file bug reports at
110             L<https://rt.cpan.org/Public/Dist/Display.html?Name=PPIx-Regexp>,
111             L<https://github.com/trwyant/perl-PPIx-Regexp/issues>, or in
112             electronic mail to the author.
113              
114             =head1 AUTHOR
115              
116             Thomas R. Wyant, III F<wyant at cpan dot org>
117              
118             =head1 COPYRIGHT AND LICENSE
119              
120             Copyright (C) 2009-2023, 2025 by Thomas R. Wyant, III
121              
122             This program is free software; you can redistribute it and/or modify it
123             under the same terms as Perl 5.10.0. For more details, see the full text
124             of the licenses in the directory LICENSES.
125              
126             This program is distributed in the hope that it will be useful, but
127             without any warranty; without even the implied warranty of
128             merchantability or fitness for a particular purpose.
129              
130             =cut
131              
132             # ex: set textwidth=72 :