blob: 0524799e3f8ec1478c8907e9fe4930ba89650663 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
package smartmatch;
use strict;
use warnings;
use 5.010;
# ABSTRACT: pluggable smart matching backends
use parent 'DynaLoader';
use B::Hooks::OP::Check;
use Module::Runtime 'use_package_optimistically';
use Package::Stash;
sub dl_load_flags { 0x01 }
__PACKAGE__->bootstrap(
# we need to be careful not to touch $VERSION at compile time, otherwise
# DynaLoader will assume it's set and check against it, which will cause
# fail when being run in the checkout without dzil having set the actual
# $VERSION
exists $smartmatch::{VERSION}
? ${ $smartmatch::{VERSION} } : (),
);
=head1 SYNOPSIS
1 ~~ 2; # false
{
use smartmatch sub { 1 };
1 ~~ 2; # true
no smartmatch;
1 ~~ 2; # false
use smartmatch 'custom';
1 ~~ 2; # smartmatch::engine::custom::match(1, 2)
}
1 ~~ 2; # false
=head1 DESCRIPTION
NOTE: This module is still experimental, and the API may change at any point.
You have been warned!
This module allows you to override the behavior of the smart match operator
(C<~~>). C<use smartmatch $matcher> hooks into the compiler to replace the
smartmatch opcode with a call to a custom subroutine, specified either as a
coderef or as a string, which will have C<smartmatch::engine::> prepended to it
and used as the name of a package in which to find a subroutine named C<match>.
The subroutine will be called with two arguments, the values on the left and
right sides of the smart match operator, and should return the result.
This module is lexically scoped, and you can call C<no smartmatch> to restore
the core perl smart matching behavior.
=cut
my $anon = 1;
sub import {
my $package = shift;
my ($cb) = @_;
my $engine;
if (ref($cb)) {
$engine = 'smartmatch::engine::__ANON__::' . $anon;
my $anon_stash = Package::Stash->new($engine);
$anon_stash->add_symbol('&match' => $cb);
$anon++;
}
else {
$engine = "smartmatch::engine::$cb";
use_package_optimistically($engine);
die "$engine does not implement a 'match' function"
unless $engine->can('match');
}
register($engine);
}
sub unimport {
unregister();
}
=head1 BUGS
No known bugs.
Please report any bugs through RT: email
C<bug-smartmatch at rt.cpan.org>, or browse to
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=smartmatch>.
=head1 SEE ALSO
L<perlsyn/"Smart matching in detail">
L<smartmatch::engine::core>
=head1 SUPPORT
You can find this documentation for this module with the perldoc command.
perldoc smartmatch
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/smartmatch>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/smartmatch>
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=smartmatch>
=item * Search CPAN
L<http://search.cpan.org/dist/smartmatch>
=back
=begin Pod::Coverage
import
unimport
register
unregister
=end Pod::Coverage
=cut
1;
|
