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