File Coverage

blib/lib/Syntax/Operator/Equ.pm
Criterion Covered Total %
statement 35 40 87.5
branch 7 8 87.5
condition 2 3 66.6
subroutine 10 12 83.3
pod 2 5 40.0
total 56 68 82.3


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, 2021-2024 -- leonerd@leonerd.org.uk
5              
6             package Syntax::Operator::Equ 0.10;
7              
8 7     7   1617525 use v5.14;
  7         32  
9 7     7   51 use warnings;
  7         18  
  7         462  
10              
11 7     7   45 use Carp;
  7         13  
  7         598  
12              
13 7     7   5253 use meta 0.003_002;
  7         8083  
  7         367  
14 7     7   77 no warnings 'meta::experimental';
  7         13  
  7         3822  
15              
16             require XSLoader;
17             XSLoader::load( __PACKAGE__, our $VERSION );
18              
19             =head1 NAME
20              
21             C - equality operators that distinguish C
22              
23             =head1 SYNOPSIS
24              
25             On Perl v5.38 or later:
26              
27             use v5.38;
28             use Syntax::Operator::Equ;
29              
30             if($x equ $y) {
31             say "x and y are both undef, or both defined and equal strings";
32             }
33              
34             if($i === $j) {
35             say "i and j are both undef, or both defined and equal numbers";
36             }
37              
38             Or via L on Perl v5.14 or later:
39              
40             use v5.14;
41             use Syntax::Keyword::Match;
42             use Syntax::Operator::Equ;
43              
44             match($str : equ) {
45             case(undef) { say "The variable is not defined" }
46             case("") { say "The variable is defined but is empty" }
47             default { say "The string is non-empty" }
48             }
49              
50             =head1 DESCRIPTION
51              
52             This module provides infix operators that implement equality tests of strings
53             or numbers similar to perl's C and C<==> operators, except that they
54             consider C to be a distinct value, separate from the empty string or
55             the number zero.
56              
57             These operators do not warn when either or both operands are C. They
58             yield true if both operands are C, false if exactly one operand is, or
59             otherwise behave the same as the regular string or number equality tests if
60             both operands are defined.
61              
62             Support for custom infix operators was added in the Perl 5.37.x development
63             cycle and is available from development release v5.37.7 onwards, and therefore
64             in Perl v5.38 onwards. The documentation of L
65             describes the situation in more detail.
66              
67             While Perl versions before this do not support custom infix operators, they
68             can still be used via C and hence L.
69             Custom keywords which attempt to parse operator syntax may be able to use
70             these. One such module is L; see the SYNOPSIS example
71             given above.
72              
73             =cut
74              
75             sub import
76             {
77 6     6   463 my $pkg = shift;
78 6         29 my $caller = caller;
79              
80 6         29 $pkg->import_into( $caller, @_ );
81             }
82              
83             sub unimport
84             {
85 2     2   563 my $pkg = shift;
86 2         6 my $caller = caller;
87              
88 2         12 $pkg->unimport_into( $caller, @_ );
89             }
90              
91 6     6 0 26 sub import_into { shift->apply( 1, @_ ) }
92 2     2 0 10 sub unimport_into { shift->apply( 0, @_ ) }
93              
94             sub apply
95             {
96 8     8 0 19 my $pkg = shift;
97 8         27 my ( $on, $caller, @syms ) = @_;
98              
99 8 100       43 @syms or @syms = qw( equ === );
100              
101 8         43 $pkg->XS::Parse::Infix::apply_infix( $on, \@syms, qw( equ === ) );
102              
103 8         525 my %syms = map { $_ => 1 } @syms;
  5         15  
104 8         17 my $callerpkg;
105              
106 8         21 foreach (qw( is_strequ is_numequ )) {
107 16 100       56 next unless delete $syms{$_};
108              
109 5   66     137 $callerpkg //= meta::package->get( $caller );
110              
111 5 100       23 $on ? $callerpkg->add_symbol( '&'.$_ => \&{$_} )
  4         33  
112             : $callerpkg->remove_symbol( '&'.$_ );
113             }
114              
115 8 50       7178 croak "Unrecognised import symbols @{[ keys %syms ]}" if keys %syms;
  0            
116             }
117              
118             =head1 OPERATORS
119              
120             =head2 equ
121              
122             my $equal = $lhs equ $rhs;
123              
124             Yields true if both operands are C, or if both are defined and contain
125             equal string values. Yields false if given exactly one C, or two
126             unequal strings.
127              
128             =head2 ===
129              
130             my $equal = $lhs === $rhs;
131              
132             Yields true if both operands are C, or if both are defined and contain
133             equal numerical values. Yields false if given exactly one C, or two
134             unequal numbers.
135              
136             Note that while this operator will not cause warnings about uninitialized
137             values, it can still warn if given defined stringy values that are not valid
138             as numbers.
139              
140             =cut
141              
142             =head1 FUNCTIONS
143              
144             As a convenience, the following functions may be imported which implement the
145             same behaviour as the infix operators, though are accessed via regular
146             function call syntax.
147              
148             These wrapper functions are implemented using L, and thus
149             have an optimising call-checker attached to them. In most cases, code which
150             calls them should not in fact have the full runtime overhead of a function
151             call because the underlying test operator will get inlined into the calling
152             code at compiletime. In effect, code calling these functions should run with
153             the same performance as code using the infix operators directly.
154              
155             =head2 is_strequ
156              
157             my $equal = is_strequ( $lhs, $rhs );
158              
159             A function version of the L stringy operator.
160              
161             =head2 is_numequ
162              
163             my $equal = is_numequ( $lhs, $rgh );
164              
165             A function version of the L numerical operator.
166              
167             =cut
168              
169             =head1 SEE ALSO
170              
171             =over 4
172              
173             =item *
174              
175             L - string equality and regexp match operator
176              
177             =back
178              
179             =head1 AUTHOR
180              
181             Paul Evans
182              
183             =cut
184              
185             0x55AA;