]> git.vpit.fr Git - perl/modules/re-engine-Hooks.git/blob - engine/Hooks.pm
Update VPIT::TestHelpers to 15e8aee3
[perl/modules/re-engine-Hooks.git] / engine / Hooks.pm
1 package re::engine::Hooks;
2
3 use 5.010001;
4
5 use strict;
6 use warnings;
7
8 =head1 NAME
9
10 re::engine::Hooks - Hookable variant of the Perl core regular expression engine.
11
12 =head1 VERSION
13
14 Version 0.03
15
16 =cut
17
18 our ($VERSION, @ISA);
19
20 sub dl_load_flags { 0x01 }
21
22 BEGIN {
23  $VERSION = '0.03';
24  require DynaLoader;
25  push @ISA, qw<Regexp DynaLoader>;
26  __PACKAGE__->bootstrap($VERSION);
27 }
28
29 =head1 SYNOPSIS
30
31 In your XS file :
32
33     #include "re_engine_hooks.h"
34
35     STATIC void dri_comp_node_hook(pTHX_ regexp *rx, regnode *node) {
36      ...
37     }
38
39     STATIC void dri_exec_node_hook(pTHX_
40        regexp *rx, regnode *node, regmatch_info *info, regmatch_state *state) {
41      ...
42     }
43
44     MODULE = Devel::Regexp::Instrument    PACKAGE = Devel::Regexp::Instrument
45
46     BOOT:
47     {
48      reh_config cfg;
49      cfg.comp_node = dri_comp_node_hook;
50      cfg.exec_node = dri_exec_node_hook;
51      reh_register("Devel::Regexp::Instrument", &cfg);
52     }
53
54 In your Perl module file :
55
56     package Devel::Regexp::Instrument;
57
58     use strict;
59     use warnings;
60
61     our ($VERSION, @ISA);
62
63     use re::engine::Hooks; # Before loading our own shared library
64
65     BEGIN {
66      $VERSION = '0.01';
67      require DynaLoader;
68      push @ISA, 'DynaLoader';
69      __PACKAGE__->bootstrap($VERSION);
70     }
71
72     sub import   { re::engine::Hooks::enable(__PACKAGE__) }
73
74     sub unimport { re::engine::Hooks::disable(__PACKAGE__) }
75
76     1;
77
78 In your F<Makefile.PL>
79
80     use ExtUtils::Depends;
81
82     my $ed = ExtUtils::Depends->new(
83      'Devel::Regexp::Instrument' => 're::engine::Hooks',
84     );
85
86     WriteMakefile(
87      $ed->get_makefile_vars,
88      ...
89     );
90
91 =head1 DESCRIPTION
92
93 This module provides a version of the perl regexp engine that can call user-defined XS callbacks at the compilation and at the execution of each regexp node.
94
95 =head1 C API
96
97 The C API is made available through the F<re_engine_hooks.h> header file.
98
99 =head2 C<reh_comp_node_hook>
100
101 The typedef for the regexp node compilation phase hook.
102 Currently evaluates to :
103
104     typedef void (*reh_comp_node_hook)(pTHX_ regexp *, regnode *);
105
106 =head2 C<reh_exec_node_hook>
107
108 The typedef for the regexp node_execution phase hook.
109 Currently evaluates to :
110
111     typedef void (*reh_exec_node_hook)(pTHX_ regexp *, regnode *, regmatch_info *, regmatch_state *);
112
113 =head2 C<reh_config>
114
115 A typedef'd struct that holds a set of all the different callbacks publicized by this module.
116 It has the following members :
117
118 =over 4
119
120 =item *
121
122 C<comp_node>
123
124 A function pointer of type C<reh_comp_node_hook> that will be called each time a regnode is compiled.
125 Allowed to be C<NULL> if you don't want to call anything for this phase.
126
127 =item *
128
129 C<exec_node>
130
131 A function pointer of type C<reh_exec_node_hook> that will be called each time a regnode is executed.
132 Allowed to be C<NULL> if you don't want to call anything for this phase.
133
134 =back
135
136 =head2 C<reh_register>
137
138     void reh_register(pTHX_ const char *key, reh_config *cfg);
139
140 Registers the callbacks specified by the C<reh_config *> object C<cfg> under the given name C<key>.
141 C<cfg> can be a pointer to a static object of type C<reh_config>.
142 C<key> is expected to be a nul-terminated string and should match the argument passed to L</enable> and L</disable> in Perl land.
143 An exception will be thrown if C<key> has already been used to register callbacks.
144
145 =cut
146
147 my $RE_ENGINE = _ENGINE();
148
149 my $croak = sub {
150  require Carp;
151  Carp::croak(@_);
152 };
153
154 =head1 PERL API
155
156 =head2 C<enable>
157
158     enable $key;
159
160 Lexically enables the hooks associated with the key C<$key>.
161
162 =head2 C<disable>
163
164     disable $key;
165
166 Lexically disables the hooks associated with the key C<$key>.
167
168 =cut
169
170 sub enable {
171  my ($key) = @_;
172
173  s/^\s+//, s/\s+$// for $key;
174  $croak->('Invalid key') if $key =~ /\s/ or not _registered($key);
175  $croak->('Another regexp engine is in use') if  $^H{regcomp}
176                                              and $^H{regcomp} != $RE_ENGINE;
177
178  $^H |= 0x020000;
179
180  my $hint = $^H{+(__PACKAGE__)} // '';
181  $hint = "$key $hint";
182  $^H{+(__PACKAGE__)} = $hint;
183
184  $^H{regcomp} = $RE_ENGINE;
185
186  return;
187 }
188
189 sub disable {
190  my ($key) = @_;
191
192  s/^\s+//, s/\s+$// for $key;
193  $croak->('Invalid key') if $key =~ /\s/ or not _registered($key);
194
195  $^H |= 0x020000;
196
197  my @other_keys = grep !/^\Q$key\E$/, split /\s+/, $^H{+(__PACKAGE__)} // '';
198  $^H{+(__PACKAGE__)} = join ' ', @other_keys, '';
199
200  delete $^H{regcomp} if $^H{regcomp} and $^{regcomp} == $RE_ENGINE
201                                      and !@other_keys;
202
203  return;
204 }
205
206 =head1 EXAMPLES
207
208 Please refer to the F<t/re-engine-Hooks-TestDist/> directory in the distribution.
209 It implements a couple of simple examples.
210
211 =head1 DEPENDENCIES
212
213 L<perl> 5.10.1.
214
215 L<ExtUtils::Depends>.
216
217 =head1 SEE ALSO
218
219 L<perlreguts>.
220
221 =head1 AUTHOR
222
223 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
224
225 You can contact me by mail or on C<irc.perl.org> (vincent).
226
227 =head1 BUGS
228
229 Please report any bugs or feature requests to C<bug-re-engine-hooks at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=re-engine-Hooks>.
230 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
231
232 =head1 SUPPORT
233
234 You can find documentation for this module with the perldoc command :
235
236     perldoc re::engine::Hooks
237
238 =head1 COPYRIGHT & LICENSE
239
240 Copyright 2012 Vincent Pit, all rights reserved.
241
242 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
243
244 =cut
245
246 1;