File Coverage

blib/lib/PPIx/Regexp/Token/CharClass/POSIX.pm
Criterion Covered Total %
statement 20 24 83.3
branch 4 6 66.6
condition 4 5 80.0
subroutine 7 8 87.5
pod 1 1 100.0
total 36 44 81.8


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             PPIx::Regexp::Token::CharClass::POSIX - Represent a POSIX character class
4              
5             =head1 SYNOPSIS
6              
7             use PPIx::Regexp::Dumper;
8             PPIx::Regexp::Dumper->new( 'qr{ [[:alpha:]] }smx' )
9             ->print();
10              
11             =head1 INHERITANCE
12              
13             C<PPIx::Regexp::Token::CharClass::POSIX> is a
14             L<PPIx::Regexp::Token::CharClass|PPIx::Regexp::Token::CharClass>.
15              
16             C<PPIx::Regexp::Token::CharClass::POSIX> is the parent of
17             L<PPIx::Regexp::Token::CharClass::POSIX::Unknown|PPIx::Regexp::Token::CharClass::POSIX::Unknown>.
18              
19             =head1 DESCRIPTION
20              
21             This class represents a POSIX character class. It will only be
22             recognized within a character class.
23              
24             Note that collating symbols (e.g. C<[.ch.]>) and equivalence classes
25             (e.g. C<[=a=]>) are valid in the POSIX standard, but are not valid in
26             Perl regular expressions. These end up being represented by
27             L<PPIx::Regexp::Token::CharClass::POSIX::Unknown|PPIx::Regexp::Token::CharClass::POSIX::Unknown>,
28             and are considered a parse failure.
29              
30             =head1 METHODS
31              
32             This class provides the following public methods beyond those provided
33             by its superclass.
34              
35             =cut
36              
37             package PPIx::Regexp::Token::CharClass::POSIX;
38              
39 9     9   48 use strict;
  9         16  
  9         260  
40 9     9   30 use warnings;
  9         13  
  9         396  
41              
42 9     9   37 use base qw{ PPIx::Regexp::Token::CharClass };
  9         12  
  9         3457  
43              
44 9         4142 use PPIx::Regexp::Constant qw{
45             COOKIE_CLASS
46             COOKIE_REGEX_SET
47             MINIMUM_PERL
48             @CARP_NOT
49 9     9   38 };
  9         13  
50              
51             our $VERSION = '0.091';
52              
53             # Return true if the token can be quantified, and false otherwise
54             # sub can_be_quantified { return };
55              
56             ##=head2 is_case_sensitive
57             ##
58             ##This override of the superclass method of the same name returns true if
59             ##the character class is C<[:lower:]> or C<[:upper:]>, and false (but
60             ##defined) for all other POSIX character classes.
61             ##
62             ##=cut
63             ##
64             ##{
65             ## my %case_sensitive = map { $_ => 1 } qw{ [:lower:] [:upper:] };
66             ##
67             ## sub is_case_sensitive {
68             ## my ( $self ) = @_;
69             ## return $case_sensitive{ $self->content() } || 0;
70             ## }
71             ##}
72              
73             sub perl_version_introduced {
74             # my ( $self ) = @_;
75 1     1 1 268 return '5.006';
76             }
77              
78             {
79              
80             my %explanation = (
81             '[:alnum:]' => 'Any alphanumeric character',
82             '[:^alnum:]' => 'Anything but an alphanumeric character',
83             '[:alpha:]' => 'Any alphabetic',
84             '[:^alpha:]' => 'Anything but an alphabetic',
85             '[:ascii:]' => 'Any character in the ASCII character set',
86             '[:^ascii:]' => 'Anything but a character in the ASCII character set',
87             '[:blank:]' => 'A GNU extension, equal to a space or a horizontal tab ("\\t")',
88             '[:^blank:]' => 'A GNU extension, anything but a space or a horizontal tab ("\\t")',
89             '[:cntrl:]' => 'Any control character',
90             '[:^cntrl:]' => 'Anything but a control character',
91             '[:digit:]' => 'Any decimal digit',
92             '[:^digit:]' => 'Anything but a decimal digit',
93             '[:graph:]' => 'Any non-space printable character',
94             '[:^graph:]' => 'Anything but a non-space printable character',
95             '[:lower:]' => 'Any lowercase character',
96             '[:^lower:]' => 'Anything but a lowercase character',
97             '[:print:]' => 'Any printable character',
98             '[:^print:]' => 'Anything but a printable character',
99             '[:punct:]' => 'Any graphical character excluding "word" characters',
100             '[:^punct:]' => 'Anything but a graphical character excluding "word" characters',
101             '[:space:]' => 'Any whitespace character',
102             '[:^space:]' => 'Anything but a whitespace character',
103             '[:upper:]' => 'Any uppercase character',
104             '[:^upper:]' => 'Anything but an uppercase character',
105             '[:word:]' => 'A Perl extension, equivalent to "\\w"',
106             '[:^word:]' => 'A Perl extension, equivalent to "\\W"',
107             '[:xdigit:]' => 'Any hexadecimal digit',
108             '[:^xdigit:]' => 'Anything but a hexadecimal digit',
109             );
110              
111             sub __explanation {
112 28     28   55 return \%explanation;
113             }
114              
115             sub __no_explanation {
116 0     0   0 my ( $self ) = @_;
117 0         0 local $_ = $self->content();
118 0 0       0 m/ \A \[ = ( . ) = \] \z /smx
119             and return "POSIX Character Equivalent (to '$1'; " .
120             "unimplemented in Perl)";
121 0         0 return q<Unknown POSIX character class>;
122             }
123              
124             }
125              
126             {
127              
128             my %class = (
129             ':' => __PACKAGE__,
130             );
131              
132             sub __PPIX_TOKENIZER__regexp {
133 1083     1083   1641 my ( undef, $tokenizer ) = @_; # Invocant, $character unused
134              
135 1083 100 100     1847 $tokenizer->cookie( COOKIE_CLASS )
136             or $tokenizer->cookie( COOKIE_REGEX_SET )
137             or return;
138              
139 146 100       397 if ( my $accept = $tokenizer->find_regexp(
140             qr{ \A [[] ( [.=:] ) \^? .*? \1 []] }smx ) ) {
141 37         81 my ( $punc ) = $tokenizer->capture();
142             return $tokenizer->make_token( $accept,
143 37   50     145 $class{$punc} || __PACKAGE__ . '::Unknown' );
144             }
145              
146 109         204 return;
147              
148             }
149              
150             }
151              
152             1;
153              
154             __END__
155              
156             =head1 SUPPORT
157              
158             Support is by the author. Please file bug reports at
159             L<https://rt.cpan.org/Public/Dist/Display.html?Name=PPIx-Regexp>,
160             L<https://github.com/trwyant/perl-PPIx-Regexp/issues>, or in
161             electronic mail to the author.
162              
163             =head1 AUTHOR
164              
165             Thomas R. Wyant, III F<wyant at cpan dot org>
166              
167             =head1 COPYRIGHT AND LICENSE
168              
169             Copyright (C) 2009-2023, 2025 by Thomas R. Wyant, III
170              
171             This program is free software; you can redistribute it and/or modify it
172             under the same terms as Perl 5.10.0. For more details, see the full text
173             of the licenses in the directory LICENSES.
174              
175             This program is distributed in the hope that it will be useful, but
176             without any warranty; without even the implied warranty of
177             merchantability or fitness for a particular purpose.
178              
179             =cut
180              
181             # ex: set textwidth=72 :