File Coverage

blib/lib/MooseX/Declare/Context.pm
Criterion Covered Total %
statement 64 64 100.0
branch 16 20 80.0
condition 3 3 100.0
subroutine 13 13 100.0
pod 3 6 50.0
total 99 106 93.4


line stmt bran cond sub pod time code
1             package MooseX::Declare::Context;
2             # ABSTRACT: Per-keyword declaration context
3             $MooseX::Declare::Context::VERSION = '0.39';
4 24     24   24807 use Moose 0.90;
  24         816  
  24         283  
5 24     24   192641 use Moose::Util::TypeConstraints;
  24         143  
  24         449  
6 24     24   85367 use Carp qw/croak/;
  24         650  
  24         1652  
7              
8 24     24   134 use aliased 'Devel::Declare::Context::Simple', 'DDContext';
  24         46  
  24         263  
9              
10 24     24   4723 use namespace::clean -except => 'meta';
  24         47  
  24         278  
11              
12             #pod =head1 DESCRIPTION
13             #pod
14             #pod This is not a subclass of L<Devel::Declare::Context::Simple>, but it will
15             #pod delegate all default methods and extend it with some attributes and methods
16             #pod of its own.
17             #pod
18             #pod A context object will be instanciated for every keyword that is handled by
19             #pod L<MooseX::Declare>. If handlers want to communicate with other handlers (for
20             #pod example handlers that will only be setup inside a namespace block) it must
21             #pod do this via the generated code.
22             #pod
23             #pod In addition to all the methods documented here, all methods from
24             #pod L<Devel::Declare::Context::Simple> are available and will be delegated to an
25             #pod internally stored instance of it.
26             #pod
27             #pod =type BlockCodePart
28             #pod
29             #pod An C<ArrayRef> with at least one element that stringifies to either C<BEGIN>
30             #pod or C<END>. The other parts will be stringified and used as the body for the
31             #pod generated block. An example would be this compiletime role composition:
32             #pod
33             #pod ['BEGIN', 'with q{ MyRole }']
34             #pod
35             #pod =cut
36              
37             subtype 'MooseX::Declare::BlockCodePart',
38             as 'ArrayRef',
39             where { @$_ > 1 and sub { grep { $_[0] eq $_ } qw( BEGIN END ) } -> ($_->[0]) };
40              
41             #pod =type CodePart
42             #pod
43             #pod A part of code represented by either a C<Str> or a L</BlockCodePart>.
44             #pod
45             #pod =cut
46              
47             subtype 'MooseX::Declare::CodePart',
48             as 'Str|MooseX::Declare::BlockCodePart';
49              
50             has _dd_context => (
51             is => 'ro',
52             isa => DDContext,
53             required => 1,
54             builder => '_build_dd_context',
55             lazy => 1,
56             handles => qr/.*/,
57             );
58              
59             has _dd_init_args => (
60             is => 'rw',
61             isa => 'HashRef',
62             default => sub { {} },
63             required => 1,
64             );
65              
66              
67             has provided_by => (
68             is => 'ro',
69             isa => 'ClassName',
70             required => 1,
71             );
72              
73              
74             #pod =attr caller_file
75             #pod
76             #pod A required C<Str> containing the file the keyword was encountered in.
77             #pod
78             #pod =cut
79              
80             has caller_file => (
81             is => 'rw',
82             isa => 'Str',
83             required => 1,
84             );
85              
86             #pod =attr preamble_code_parts
87             #pod
88             #pod An C<ArrayRef> of L</CodePart>s that will be used as preamble. A preamble in
89             #pod this context means the beginning of the generated code.
90             #pod
91             #pod =method add_preamble_code_parts(CodePart @parts)
92             #pod
93             #pod Object->add_preamble_code_parts (CodeRef @parts)
94             #pod
95             #pod See L</add_cleanup_code_parts>.
96             #pod
97             #pod =cut
98              
99             has preamble_code_parts => (
100             traits => ['Array'],
101             is => 'ro',
102             isa => 'ArrayRef[MooseX::Declare::CodePart]',
103             required => 1,
104             default => sub { [] },
105             handles => {
106             add_preamble_code_parts => 'push',
107             },
108             );
109              
110             #pod =attr scope_code_parts
111             #pod
112             #pod These parts will come before the actual body and after the
113             #pod L</preamble_code_parts>. It is an C<ArrayRef> of L</CodePart>s.
114             #pod
115             #pod =method add_scope_code_parts(CodePart @parts)
116             #pod
117             #pod Object->add_scope_code_parts (CodeRef @parts)
118             #pod
119             #pod See L</add_cleanup_code_parts>.
120             #pod
121             #pod =cut
122              
123             has scope_code_parts => (
124             traits => ['Array'],
125             is => 'ro',
126             isa => 'ArrayRef[MooseX::Declare::CodePart]',
127             required => 1,
128             default => sub { [] },
129             handles => {
130             add_scope_code_parts => 'push',
131             },
132             );
133              
134             #pod =attr cleanup_code_parts
135             #pod
136             #pod An C<ArrayRef> of L</CodePart>s that will not be directly inserted
137             #pod into the code, but instead be installed in a handler that will run at
138             #pod the end of the scope so you can do namespace cleanups and such.
139             #pod
140             #pod =method add_cleanup_code_parts(CodePart @parts)
141             #pod
142             #pod Object->add_cleanup_code_parts (CodeRef @parts)
143             #pod
144             #pod For these three methods please look at the corresponding C<*_code_parts>
145             #pod attribute in the list above. These methods are merely convenience methods
146             #pod that allow adding entries to the code part containers.
147             #pod
148             #pod =cut
149              
150             has cleanup_code_parts => (
151             traits => ['Array'],
152             is => 'ro',
153             isa => 'ArrayRef[MooseX::Declare::CodePart]',
154             required => 1,
155             default => sub { [] },
156             handles => {
157             add_cleanup_code_parts => 'push',
158             add_early_cleanup_code_parts => 'unshift',
159             },
160             );
161              
162             #pod =attr stack
163             #pod
164             #pod An C<ArrayRef> that contains the stack of handlers. A keyword that was
165             #pod only setup inside a scoped block will have the blockhandler be put in
166             #pod the stack.
167             #pod
168             #pod =cut
169              
170             has stack => (
171             is => 'rw',
172             isa => 'ArrayRef',
173             default => sub { [] },
174             required => 1,
175             );
176              
177             #pod =method inject_code_parts_here
178             #pod
179             #pod True Object->inject_code_parts_here (CodePart @parts)
180             #pod
181             #pod Will inject the passed L</CodePart>s at the current position in the code.
182             #pod
183             #pod =cut
184              
185             sub inject_code_parts_here {
186 4     4 1 16 my ($self, @parts) = @_;
187              
188             # get code to inject and rest of line
189 4         24 my $inject = $self->_joined_statements(\@parts);
190 4         24 my $linestr = $self->get_linestr;
191              
192             # add code to inject to current line and inject it
193 4         88 substr($linestr, $self->offset, 0, "$inject");
194 4         78 $self->set_linestr($linestr);
195              
196 4         107 return 1;
197             }
198              
199             #pod =method peek_next_char
200             #pod
201             #pod Str Object->peek_next_char ()
202             #pod
203             #pod Will return the next char without stripping it from the stream.
204             #pod
205             #pod =cut
206              
207             sub peek_next_char {
208 66     66 1 150 my ($self) = @_;
209              
210             # return next char in line
211 66         260 my $linestr = $self->get_linestr;
212 66         16574 return substr $linestr, $self->offset, 1;
213             }
214              
215             sub peek_next_word {
216 64     64 0 156 my ($self) = @_;
217              
218 64         245 $self->skipspace;
219              
220 64         1251 my $len = Devel::Declare::toke_scan_word($self->offset, 1);
221 64 100       1053 return unless $len;
222              
223 63         231 my $linestr = $self->get_linestr;
224 63         1138 return substr($linestr, $self->offset, $len);
225             }
226              
227             #pod =method inject_code_parts
228             #pod
229             #pod Object->inject_code_parts (
230             #pod Bool :$inject_cleanup_code_parts,
231             #pod CodeRef :$missing_block_handler
232             #pod )
233             #pod
234             #pod This will inject the code parts from the attributes above at the current
235             #pod position. The preamble and scope code parts will be inserted first. Then
236             #pod then call to the cleanup code will be injected, unless the options
237             #pod contain a key named C<inject_cleanup_code_parts> with a false value.
238             #pod
239             #pod The C<inject_if_block> method will be called if the next char is a C<{>
240             #pod indicating a following block.
241             #pod
242             #pod If it is not a block, but a semi-colon is found and the options
243             #pod contained a C<missing_block_handler> key was passed, it will be called
244             #pod as method on the context object with the code to inject and the
245             #pod options as arguments. All options that are not recognized are passed
246             #pod through to the C<missing_block_handler>. You are well advised to prefix
247             #pod option names in your extensions.
248             #pod
249             #pod =cut
250              
251             sub inject_code_parts {
252 61     61 1 247 my ($self, %args) = @_;
253              
254             # default to injecting cleanup code
255 61 50       348 $args{inject_cleanup_code_parts} = 1
256             unless exists $args{inject_cleanup_code_parts};
257              
258             # add preamble and scope statements to injected code
259 61         118 my $inject;
260 61         422 $inject .= $self->_joined_statements('preamble');
261 61         303 $inject .= ';' . $self->_joined_statements('scope');
262              
263             # if we should also inject the cleanup code
264 61 50       250 if ($args{inject_cleanup_code_parts}) {
265 61         195 $inject .= ';' . $self->scope_injector_call($self->_joined_statements('cleanup'));
266             }
267              
268 61         1816 $inject .= ';';
269              
270             # we have a block
271 61 100       374 if ($self->peek_next_char eq '{') {
272 60         1836 $self->inject_if_block("$inject");
273             }
274              
275             # there was no block to inject into
276             else {
277             # require end of statement
278 1 50       17 croak "block or semi-colon expected after " . $self->declarator . " statement"
279             unless $self->peek_next_char eq ';';
280              
281             # if we can't handle non-blocks, we expect one
282 1 50       17 croak "block expected after " . $self->declarator . " statement"
283             unless exists $args{missing_block_handler};
284              
285             # delegate the processing of the missing block
286 1         5 $args{missing_block_handler}->($self, $inject, %args);
287             }
288              
289 61         3315 return 1;
290             }
291              
292             sub _joined_statements {
293 187     187   367 my ($self, $section) = @_;
294              
295             # if the section was not an array reference, get the
296             # section contents of that name
297 187 100       496 $section = $self->${\"${section}_code_parts"}
  183         8382  
298             unless ref $section;
299              
300             # join statements via semicolon
301             # array references are expected to be in the form [FOO => 1, 2, 3]
302             # which would yield BEGIN { 1; 2; 3 }
303             return join '; ', map {
304 374 100       1151 not( ref $_ ) ? $_ : do {
  187         462  
305 61         164 my ($block, @parts) = @$_;
306 61         775 sprintf '%s { %s }', $block, join '; ', @parts;
307             };
308 187         509 } @{ $section };
309             }
310              
311             sub BUILD {
312 129     129 0 154376 my ($self, $attrs) = @_;
313              
314             # remember the constructor arguments for the delegated context
315 129         6047 $self->_dd_init_args($attrs);
316             }
317              
318             sub _build_dd_context {
319 129     129   346 my ($self) = @_;
320              
321             # create delegated context with remembered arguments
322 129         295 return DDContext->new(%{ $self->_dd_init_args });
  129         5258  
323             }
324              
325             sub strip_word {
326 65     65 0 154 my ($self) = @_;
327              
328 65         394 $self->skipspace;
329 65         1757 my $linestr = $self->get_linestr;
330 65 100       1450 return if substr($linestr, $self->offset, 1) =~ /[{;]/;
331              
332             # TODO:
333             # - provide a reserved_words attribute
334             # - allow keywords to consume reserved_words autodiscovery role
335 64         1551 my $word = $self->peek_next_word;
336 64 100 100     1455 return if !defined $word || $word =~ /^(?:extends|with|is)$/;
337              
338 61         429 return scalar $self->strip_name;
339             }
340              
341             #pod =head1 SEE ALSO
342             #pod
343             #pod =for :list
344             #pod * L<MooseX::Declare>
345             #pod * L<Devel::Declare>
346             #pod * L<Devel::Declare::Context::Simple>
347             #pod
348             #pod =cut
349              
350             1;
351              
352             __END__
353              
354             =pod
355              
356             =encoding UTF-8
357              
358             =head1 NAME
359              
360             MooseX::Declare::Context - Per-keyword declaration context
361              
362             =head1 VERSION
363              
364             version 0.39
365              
366             =head1 DESCRIPTION
367              
368             This is not a subclass of L<Devel::Declare::Context::Simple>, but it will
369             delegate all default methods and extend it with some attributes and methods
370             of its own.
371              
372             A context object will be instanciated for every keyword that is handled by
373             L<MooseX::Declare>. If handlers want to communicate with other handlers (for
374             example handlers that will only be setup inside a namespace block) it must
375             do this via the generated code.
376              
377             In addition to all the methods documented here, all methods from
378             L<Devel::Declare::Context::Simple> are available and will be delegated to an
379             internally stored instance of it.
380              
381             =head1 ATTRIBUTES
382              
383             =head2 caller_file
384              
385             A required C<Str> containing the file the keyword was encountered in.
386              
387             =head2 preamble_code_parts
388              
389             An C<ArrayRef> of L</CodePart>s that will be used as preamble. A preamble in
390             this context means the beginning of the generated code.
391              
392             =head2 scope_code_parts
393              
394             These parts will come before the actual body and after the
395             L</preamble_code_parts>. It is an C<ArrayRef> of L</CodePart>s.
396              
397             =head2 cleanup_code_parts
398              
399             An C<ArrayRef> of L</CodePart>s that will not be directly inserted
400             into the code, but instead be installed in a handler that will run at
401             the end of the scope so you can do namespace cleanups and such.
402              
403             =head2 stack
404              
405             An C<ArrayRef> that contains the stack of handlers. A keyword that was
406             only setup inside a scoped block will have the blockhandler be put in
407             the stack.
408              
409             =head1 METHODS
410              
411             =head2 add_preamble_code_parts(CodePart @parts)
412              
413             Object->add_preamble_code_parts (CodeRef @parts)
414              
415             See L</add_cleanup_code_parts>.
416              
417             =head2 add_scope_code_parts(CodePart @parts)
418              
419             Object->add_scope_code_parts (CodeRef @parts)
420              
421             See L</add_cleanup_code_parts>.
422              
423             =head2 add_cleanup_code_parts(CodePart @parts)
424              
425             Object->add_cleanup_code_parts (CodeRef @parts)
426              
427             For these three methods please look at the corresponding C<*_code_parts>
428             attribute in the list above. These methods are merely convenience methods
429             that allow adding entries to the code part containers.
430              
431             =head2 inject_code_parts_here
432              
433             True Object->inject_code_parts_here (CodePart @parts)
434              
435             Will inject the passed L</CodePart>s at the current position in the code.
436              
437             =head2 peek_next_char
438              
439             Str Object->peek_next_char ()
440              
441             Will return the next char without stripping it from the stream.
442              
443             =head2 inject_code_parts
444              
445             Object->inject_code_parts (
446             Bool :$inject_cleanup_code_parts,
447             CodeRef :$missing_block_handler
448             )
449              
450             This will inject the code parts from the attributes above at the current
451             position. The preamble and scope code parts will be inserted first. Then
452             then call to the cleanup code will be injected, unless the options
453             contain a key named C<inject_cleanup_code_parts> with a false value.
454              
455             The C<inject_if_block> method will be called if the next char is a C<{>
456             indicating a following block.
457              
458             If it is not a block, but a semi-colon is found and the options
459             contained a C<missing_block_handler> key was passed, it will be called
460             as method on the context object with the code to inject and the
461             options as arguments. All options that are not recognized are passed
462             through to the C<missing_block_handler>. You are well advised to prefix
463             option names in your extensions.
464              
465             =head1 TYPES
466              
467             =head2 BlockCodePart
468              
469             An C<ArrayRef> with at least one element that stringifies to either C<BEGIN>
470             or C<END>. The other parts will be stringified and used as the body for the
471             generated block. An example would be this compiletime role composition:
472              
473             ['BEGIN', 'with q{ MyRole }']
474              
475             =head2 CodePart
476              
477             A part of code represented by either a C<Str> or a L</BlockCodePart>.
478              
479             =head1 SEE ALSO
480              
481             =over 4
482              
483             =item *
484              
485             L<MooseX::Declare>
486              
487             =item *
488              
489             L<Devel::Declare>
490              
491             =item *
492              
493             L<Devel::Declare::Context::Simple>
494              
495             =back
496              
497             =head1 AUTHOR
498              
499             Florian Ragwitz <rafl@debian.org>
500              
501             =head1 COPYRIGHT AND LICENSE
502              
503             This software is copyright (c) 2008 by Florian Ragwitz.
504              
505             This is free software; you can redistribute it and/or modify it under
506             the same terms as the Perl 5 programming language system itself.
507              
508             =cut