File Coverage

blib/lib/Syntax/Operator/Eqr.pm
Criterion Covered Total %
statement 35 36 97.2
branch 6 8 75.0
condition 1 3 33.3
subroutine 10 10 100.0
pod 0 3 0.0
total 52 60 86.6


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2023-2024 -- leonerd@leonerd.org.uk
5              
6             package Syntax::Operator::Eqr 0.10;
7              
8 3     3   169159 use v5.14;
  3         14  
9 3     3   18 use warnings;
  3         12  
  3         173  
10              
11 3     3   37 use Carp;
  3         9  
  3         263  
12              
13 3     3   455 use meta 0.003_002;
  3         856  
  3         174  
14 3     3   19 no warnings 'meta::experimental';
  3         25  
  3         1712  
15              
16             # Load the XS code
17             require Syntax::Operator::Equ;
18              
19             =head1 NAME
20              
21             C - string equality and regexp match operator
22              
23             =head1 SYNOPSIS
24              
25             On Perl v5.38 or later:
26              
27             use v5.38;
28             use Syntax::Operator::Eqr;
29              
30             if($str eqr $pat) {
31             say "x and y are both undef, or both defined and equal strings, " .
32             "or y is a regexp that matches x";
33             }
34              
35             Or via L on Perl v5.14 or later:
36              
37             use v5.14;
38             use Syntax::Keyword::Match;
39             use Syntax::Operator::Eqr;
40              
41             match($str : eqr) {
42             case(undef) { say "The variable is not defined" }
43             case("") { say "The variable is defined but is empty" }
44             case(qr/^.$/) { say "The variable contains exactly one character" }
45             default { say "The string contains more than one" }
46             }
47              
48             =head1 DESCRIPTION
49              
50             This module provides an infix operators that implements a matching operation
51             whose behaviour depends on whether the right-hand side operand is undef, a
52             quoted regexp object, or some other value. If undef, it is true only if the
53             lefthand operand is also undef. If a quoted regexp object, it behaves like
54             Perl's C<=~> pattern-matching operator. If neither, it behaves like the C
55             operator.
56              
57             This operator does not warn when either or both operands are C.
58              
59             Support for custom infix operators was added in the Perl 5.37.x development
60             cycle and is available from development release v5.37.7 onwards, and therefore
61             in Perl v5.38 onwards. The documentation of L
62             describes the situation in more detail.
63              
64             While Perl versions before this do not support custom infix operators, they
65             can still be used via C and hence L.
66             Custom keywords which attempt to parse operator syntax may be able to use
67             these. One such module is L; see the SYNOPSIS example
68             given above.
69              
70             =head2 Comparison With Smartmatch
71              
72             At first glance it would appear a little similar to core perl's ill-fated
73             smartmatch operator (C<~~>), but this version is much simpler. It does not try
74             to determine if stringy or numerical match is preferred, nor does it attempt
75             to make sense of any C, C, C or other complicated container
76             values on either side. Its behaviour is in effect entirely determined by the
77             value on its righthand side - the three cases of C, some C
78             object, or anything else.
79              
80             This in particular makes it behave sensibly with the C syntax
81             provided by L.
82              
83             =cut
84              
85             sub import
86             {
87 2     2   18 my $pkg = shift;
88 2         5 my $caller = caller;
89              
90 2         7 $pkg->import_into( $caller, @_ );
91             }
92              
93             sub unimport
94             {
95 1     1   422 my $pkg = shift;
96 1         2 my $caller = caller;
97              
98 1         4 $pkg->unimport_into( $caller, @_ );
99             }
100              
101 2     2 0 7 sub import_into { shift->apply( 1, @_ ) }
102 1     1 0 17 sub unimport_into { shift->apply( 0, @_ ) }
103              
104             sub apply
105             {
106 3     3 0 7 my $pkg = shift;
107 3         12 my ( $on, $caller, @syms ) = @_;
108              
109 3 100       13 @syms or @syms = qw( eqr );
110              
111 3         17 $pkg->XS::Parse::Infix::apply_infix( $on, \@syms, qw( eqr ) );
112              
113 3         118 my %syms = map { $_ => 1 } @syms;
  1         4  
114 3         6 my $callerpkg;
115              
116 3         6 foreach (qw( is_eqr )) {
117 3 100       12 next unless delete $syms{$_};
118              
119 1   33     39 $callerpkg //= meta::package->get( $caller );
120              
121 1 50       4 $on ? $callerpkg->add_symbol( '&'.$_ => \&{$_} )
  1         9  
122             : $callerpkg->remove_symbol( '&'.$_ );
123             }
124              
125 3 50       2115 croak "Unrecognised import symbols @{[ keys %syms ]}" if keys %syms;
  0            
126             }
127              
128             =head1 OPERATORS
129              
130             =head2 eqr
131              
132             my $matches = $lhs eqr $rhs;
133              
134             Yields true if both operands are C, or if the right-hand side is a
135             quoted regexp value that matches the left-hand side, or if both are defined
136             and contain equal string values. Yields false if given exactly one C,
137             two unequal strings, or a string that does not match the pattern.
138              
139             =cut
140              
141             =head1 FUNCTIONS
142              
143             As a convenience, the following functions may be imported which implement the
144             same behaviour as the infix operators, though are accessed via regular
145             function call syntax.
146              
147             These wrapper functions are implemented using L, and thus
148             have an optimising call-checker attached to them. In most cases, code which
149             calls them should not in fact have the full runtime overhead of a function
150             call because the underlying test operator will get inlined into the calling
151             code at compiletime. In effect, code calling these functions should run with
152             the same performance as code using the infix operators directly.
153              
154             =head2 is_eqr
155              
156             my $matches = is_eqr( $lhs, $rhs );
157              
158             A function version of the L stringy operator.
159              
160             =cut
161              
162             =head1 SEE ALSO
163              
164             =over 4
165              
166             =item *
167              
168             L - equality operators that distinguish C
169              
170             =back
171              
172             =head1 AUTHOR
173              
174             Paul Evans
175              
176             =cut
177              
178             0x55AA;