0 | |
NAME
|
1 | |
Devel::Declare - Adding keywords to perl, in perl
|
2 | |
|
3 | |
SYNOPSIS
|
4 | |
use Method::Signatures;
|
5 | |
# or ...
|
6 | |
use MooseX::Declare;
|
7 | |
# etc.
|
8 | |
|
9 | |
# Use some new and exciting syntax like:
|
10 | |
method hello (Str :$who, Int :$age where { $_ > 0 }) {
|
11 | |
$self->say("Hello ${who}, I am ${age} years old!");
|
12 | |
}
|
13 | |
|
14 | |
DESCRIPTION
|
15 | |
Devel::Declare can install subroutines called declarators which locally
|
16 | |
take over Perl's parser, allowing the creation of new syntax.
|
17 | |
|
18 | |
This document describes how to create a simple declarator.
|
19 | |
|
20 | |
USAGE
|
21 | |
We'll demonstrate the usage of "Devel::Declare" with a motivating
|
22 | |
example: a new "method" keyword, which acts like the builtin "sub", but
|
23 | |
automatically unpacks $self and the other arguments.
|
24 | |
|
25 | |
package My::Methods;
|
26 | |
use Devel::Declare;
|
27 | |
|
28 | |
Creating a declarator with "setup_for"
|
29 | |
You will typically create
|
30 | |
|
31 | |
sub import {
|
32 | |
my $class = shift;
|
33 | |
my $caller = caller;
|
34 | |
|
35 | |
Devel::Declare->setup_for(
|
36 | |
$caller,
|
37 | |
{ method => { const => \&parser } }
|
38 | |
);
|
39 | |
no strict 'refs';
|
40 | |
*{$caller.'::method'} = sub (&) {};
|
41 | |
}
|
42 | |
|
43 | |
Starting from the end of this import routine, you'll see that we're
|
44 | |
creating a subroutine called "method" in the caller's namespace. Yes,
|
45 | |
that's just a normal subroutine, and it does nothing at all (yet!) Note
|
46 | |
the prototype "(&)" which means that the caller would call it like so:
|
47 | |
|
48 | |
method {
|
49 | |
my ($self, $arg1, $arg2) = @_;
|
50 | |
...
|
51 | |
}
|
52 | |
|
53 | |
However we want to be able to call it like this
|
54 | |
|
55 | |
method foo ($arg1, $arg2) {
|
56 | |
...
|
57 | |
}
|
58 | |
|
59 | |
That's why we call "setup_for" above, to register the declarator
|
60 | |
'method' with a custom parser, as per the next section. It acts on an
|
61 | |
optype, usually 'const' as above. (Other valid values are 'check' and
|
62 | |
'rv2cv').
|
63 | |
|
64 | |
For a simpler way to install new methods, see also
|
65 | |
Devel::Declare::MethodInstaller::Simple
|
66 | |
|
67 | |
Writing a parser subroutine
|
68 | |
This subroutine is called at *compilation* time, and allows you to read
|
69 | |
the custom syntaxes that we want (in a syntax that may or may not be
|
70 | |
valid core Perl 5) and munge it so that the result will be parsed by the
|
71 | |
"perl" compiler.
|
72 | |
|
73 | |
For this example, we're defining some globals for convenience:
|
74 | |
|
75 | |
our ($Declarator, $Offset);
|
76 | |
|
77 | |
Then we define a parser subroutine to handle our declarator. We'll look
|
78 | |
at this in a few chunks.
|
79 | |
|
80 | |
sub parser {
|
81 | |
local ($Declarator, $Offset) = @_;
|
82 | |
|
83 | |
"Devel::Declare" provides some very low level utility methods to parse
|
84 | |
character strings. We'll define some useful higher level routines below
|
85 | |
for convenience, and we can use these to parse the various elements in
|
86 | |
our new syntax.
|
87 | |
|
88 | |
Notice how our parser subroutine is invoked at compile time, when the
|
89 | |
"perl" parser is pointed just *before* the declarator name.
|
90 | |
|
91 | |
skip_declarator; # step past 'method'
|
92 | |
my $name = strip_name; # strip out the name 'foo', if present
|
93 | |
my $proto = strip_proto; # strip out the prototype '($arg1, $arg2)', if present
|
94 | |
|
95 | |
Now we can prepare some code to 'inject' into the new subroutine. For
|
96 | |
example we might want the method as above to have "my ($self, $arg1,
|
97 | |
$arg2) = @_" injected at the beginning of it. We also do some clever
|
98 | |
stuff with scopes that we'll look at shortly.
|
99 | |
|
100 | |
my $inject = make_proto_unwrap($proto);
|
101 | |
if (defined $name) {
|
102 | |
$inject = scope_injector_call().$inject;
|
103 | |
}
|
104 | |
inject_if_block($inject);
|
105 | |
|
106 | |
We've now managed to change "method ($arg1, $arg2) { ... }" into "method
|
107 | |
{ injected_code; ... }". This will compile... but we've lost the name of
|
108 | |
the method!
|
109 | |
|
110 | |
In a cute (or horrifying, depending on your perspective) trick, we
|
111 | |
temporarily change the definition of the subroutine "method" itself, to
|
112 | |
specialise it with the $name we stripped, so that it assigns the code
|
113 | |
block to that name.
|
114 | |
|
115 | |
Even though the *next* time "method" is compiled, it will be redefined
|
116 | |
again, "perl" caches these definitions in its parse tree, so we'll
|
117 | |
always get the right one!
|
118 | |
|
119 | |
Note that we also handle the case where there was no name, allowing an
|
120 | |
anonymous method analogous to an anonymous subroutine.
|
121 | |
|
122 | |
if (defined $name) {
|
123 | |
$name = join('::', Devel::Declare::get_curstash_name(), $name)
|
124 | |
unless ($name =~ /::/);
|
125 | |
shadow(sub (&) { no strict 'refs'; *{$name} = shift; });
|
126 | |
} else {
|
127 | |
shadow(sub (&) { shift });
|
128 | |
}
|
129 | |
}
|
130 | |
|
131 | |
Parser utilities in detail
|
132 | |
For simplicity, we're using global variables like $Offset in these
|
133 | |
examples. You may prefer to look at Devel::Declare::Context::Simple,
|
134 | |
which encapsulates the context much more cleanly.
|
135 | |
|
136 | |
"skip_declarator"
|
137 | |
This simple parser just moves across a 'token'. The common case is to
|
138 | |
skip the declarator, i.e. to move to the end of the string 'method' and
|
139 | |
before the prototype and code block.
|
140 | |
|
141 | |
sub skip_declarator {
|
142 | |
$Offset += Devel::Declare::toke_move_past_token($Offset);
|
143 | |
}
|
144 | |
|
145 | |
"toke_move_past_token"
|
146 | |
This builtin parser simply moves past a 'token' (matching
|
147 | |
"/[a-zA-Z_]\w*/") It takes an offset into the source document, and skips
|
148 | |
past the token. It returns the number of characters skipped.
|
149 | |
|
150 | |
"strip_name"
|
151 | |
This parser skips any whitespace, then scans the next word (again
|
152 | |
matching a 'token'). We can then analyse the current line, and
|
153 | |
manipulate it (using pure Perl). In this case we take the name of the
|
154 | |
method out, and return it.
|
155 | |
|
156 | |
sub strip_name {
|
157 | |
skipspace;
|
158 | |
if (my $len = Devel::Declare::toke_scan_word($Offset, 1)) {
|
159 | |
my $linestr = Devel::Declare::get_linestr();
|
160 | |
my $name = substr($linestr, $Offset, $len);
|
161 | |
substr($linestr, $Offset, $len) = '';
|
162 | |
Devel::Declare::set_linestr($linestr);
|
163 | |
return $name;
|
164 | |
}
|
165 | |
return;
|
166 | |
}
|
167 | |
|
168 | |
"toke_scan_word"
|
169 | |
This builtin parser, given an offset into the source document, matches a
|
170 | |
'token' as above but does not skip. It returns the length of the token
|
171 | |
matched, if any.
|
172 | |
|
173 | |
"get_linestr"
|
174 | |
This builtin returns the full text of the current line of the source
|
175 | |
document.
|
176 | |
|
177 | |
"set_linestr"
|
178 | |
This builtin sets the full text of the current line of the source
|
179 | |
document.
|
180 | |
|
181 | |
"skipspace"
|
182 | |
This parser skips whitsepace.
|
183 | |
|
184 | |
sub skipspace {
|
185 | |
$Offset += Devel::Declare::toke_skipspace($Offset);
|
186 | |
}
|
187 | |
|
188 | |
"toke_skipspace"
|
189 | |
This builtin parser, given an offset into the source document, skips
|
190 | |
over any whitespace, and returns the number of characters skipped.
|
191 | |
|
192 | |
"strip_proto"
|
193 | |
This is a more complex parser that checks if it's found something that
|
194 | |
starts with '(' and returns everything till the matching ')'.
|
195 | |
|
196 | |
sub strip_proto {
|
197 | |
skipspace;
|
198 | |
|
199 | |
my $linestr = Devel::Declare::get_linestr();
|
200 | |
if (substr($linestr, $Offset, 1) eq '(') {
|
201 | |
my $length = Devel::Declare::toke_scan_str($Offset);
|
202 | |
my $proto = Devel::Declare::get_lex_stuff();
|
203 | |
Devel::Declare::clear_lex_stuff();
|
204 | |
$linestr = Devel::Declare::get_linestr();
|
205 | |
substr($linestr, $Offset, $length) = '';
|
206 | |
Devel::Declare::set_linestr($linestr);
|
207 | |
return $proto;
|
208 | |
}
|
209 | |
return;
|
210 | |
}
|
211 | |
|
212 | |
"toke_scan_str"
|
213 | |
This builtin parser uses Perl's own parsing routines to match a
|
214 | |
"stringlike" expression. Handily, this includes bracketed expressions
|
215 | |
(just think about things like "q(this is a quote)").
|
216 | |
|
217 | |
Also it Does The Right Thing with nested delimiters (like "q(this (is
|
218 | |
(a) quote))").
|
219 | |
|
220 | |
It returns the length of the expression matched. Use "get_lex_stuff" to
|
221 | |
get the actual matched text.
|
222 | |
|
223 | |
"get_lex_stuff"
|
224 | |
This builtin returns what was matched by "toke_scan_str". To avoid
|
225 | |
segfaults, you should call "clear_lex_stuff" immediately afterwards.
|
226 | |
|
227 | |
Munging the subroutine
|
228 | |
Let's look at what we need to do in detail.
|
229 | |
|
230 | |
"make_proto_unwrap"
|
231 | |
We may have defined our method in different ways, which will result in a
|
232 | |
different value for our prototype, as parsed above. For example:
|
233 | |
|
234 | |
method foo { # undefined
|
235 | |
method foo () { # ''
|
236 | |
method foo ($arg1) { # '$arg1'
|
237 | |
|
238 | |
We deal with them as follows, and return the appropriate "my ($self,
|
239 | |
...) = @_;" string.
|
240 | |
|
241 | |
sub make_proto_unwrap {
|
242 | |
my ($proto) = @_;
|
243 | |
my $inject = 'my ($self';
|
244 | |
if (defined $proto) {
|
245 | |
$inject .= ", $proto" if length($proto);
|
246 | |
$inject .= ') = @_; ';
|
247 | |
} else {
|
248 | |
$inject .= ') = shift;';
|
249 | |
}
|
250 | |
return $inject;
|
251 | |
}
|
252 | |
|
253 | |
"inject_if_block"
|
254 | |
Now we need to inject it after the opening '{' of the method body. We
|
255 | |
can do this with the building blocks we defined above like "skipspace"
|
256 | |
and "get_linestr".
|
257 | |
|
258 | |
sub inject_if_block {
|
259 | |
my $inject = shift;
|
260 | |
skipspace;
|
261 | |
my $linestr = Devel::Declare::get_linestr;
|
262 | |
if (substr($linestr, $Offset, 1) eq '{') {
|
263 | |
substr($linestr, $Offset+1, 0) = $inject;
|
264 | |
Devel::Declare::set_linestr($linestr);
|
265 | |
}
|
266 | |
}
|
267 | |
|
268 | |
"scope_injector_call"
|
269 | |
We want to be able to handle both named and anonymous methods. i.e.
|
270 | |
|
271 | |
method foo () { ... }
|
272 | |
my $meth = method () { ... };
|
273 | |
|
274 | |
These will then get rewritten as
|
275 | |
|
276 | |
method { ... }
|
277 | |
my $meth = method { ... };
|
278 | |
|
279 | |
where 'method' is a subroutine that takes a code block. Spot the
|
280 | |
problem? The first one doesn't have a semicolon at the end of it! Unlike
|
281 | |
'sub' which is a builtin, this is just a normal statement, so we need to
|
282 | |
terminate it. Luckily, using "B::Hooks::EndOfScope", we can do this!
|
283 | |
|
284 | |
use B::Hooks::EndOfScope;
|
285 | |
|
286 | |
We'll add this to what gets 'injected' at the beginning of the method
|
287 | |
source.
|
288 | |
|
289 | |
sub scope_injector_call {
|
290 | |
return ' BEGIN { MethodHandlers::inject_scope }; ';
|
291 | |
}
|
292 | |
|
293 | |
So at the beginning of every method, we are passing a callback that will
|
294 | |
get invoked at the *end* of the method's compilation... i.e. exactly
|
295 | |
then the closing '}' is compiled.
|
296 | |
|
297 | |
sub inject_scope {
|
298 | |
on_scope_end {
|
299 | |
my $linestr = Devel::Declare::get_linestr;
|
300 | |
my $offset = Devel::Declare::get_linestr_offset;
|
301 | |
substr($linestr, $offset, 0) = ';';
|
302 | |
Devel::Declare::set_linestr($linestr);
|
303 | |
};
|
304 | |
}
|
305 | |
|
306 | |
Shadowing each method.
|
307 | |
"shadow"
|
308 | |
We override the current definition of 'method' using "shadow".
|
309 | |
|
310 | |
sub shadow {
|
311 | |
my $pack = Devel::Declare::get_curstash_name;
|
312 | |
Devel::Declare::shadow_sub("${pack}::${Declarator}", $_[0]);
|
313 | |
}
|
314 | |
|
315 | |
For a named method we invoked like this:
|
316 | |
|
317 | |
shadow(sub (&) { no strict 'refs'; *{$name} = shift; });
|
318 | |
|
319 | |
So in the case of a "method foo { ... }", this call would redefine
|
320 | |
"method" to be a subroutine that exports 'sub foo' as the (munged)
|
321 | |
contents of "{...}".
|
322 | |
|
323 | |
The case of an anonymous method is also cute:
|
324 | |
|
325 | |
shadow(sub (&) { shift });
|
326 | |
|
327 | |
This means that
|
328 | |
|
329 | |
my $meth = method () { ... };
|
330 | |
|
331 | |
is rewritten with "method" taking the codeblock, and returning it as is
|
332 | |
to become the value of $meth.
|
333 | |
|
334 | |
"get_curstash_name"
|
335 | |
This returns the package name *currently being compiled*.
|
336 | |
|
337 | |
"shadow_sub"
|
338 | |
Handles the details of redefining the subroutine.
|
339 | |
|
340 | |
SEE ALSO
|
341 | |
One of the best ways to learn "Devel::Declare" is still to look at
|
342 | |
modules that use it:
|
343 | |
|
344 | |
<http://cpants.perl.org/dist/used_by/Devel-Declare>.
|
345 | |
|
346 | |
AUTHORS
|
347 | |
Matt S Trout - <mst@shadowcat.co.uk> - original author
|
348 | |
|
349 | |
Company: http://www.shadowcat.co.uk/ Blog: http://chainsawblues.vox.com/
|
350 | |
|
351 | |
Florian Ragwitz <rafl@debian.org> - maintainer
|
352 | |
|
353 | |
osfameron <osfameron@cpan.org> - first draft of documentation
|
354 | |
|
355 | |
COPYRIGHT AND LICENSE
|
356 | |
This library is free software under the same terms as perl itself
|
357 | |
|
358 | |
Copyright (c) 2007, 2008, 2009 Matt S Trout
|
359 | |
|
360 | |
Copyright (c) 2008, 2009 Florian Ragwitz
|
361 | |
|
362 | |
stolen_chunk_of_toke.c based on toke.c from the perl core, which is
|
363 | |
|
364 | |
Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
|
365 | |
2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
|
366 | |
|