File Coverage

blib/lib/MooseX/Declare/Syntax/KeywordHandling.pm
Criterion Covered Total %
statement 49 49 100.0
branch 6 6 100.0
condition 2 2 100.0
subroutine 16 16 100.0
pod 3 5 60.0
total 76 78 97.4


line stmt bran cond sub pod time code
1             package MooseX::Declare::Syntax::KeywordHandling;
2             # ABSTRACT: Basic keyword functionality
3             $MooseX::Declare::Syntax::KeywordHandling::VERSION = '0.40';
4 24     24   14317 use Moose::Role;
  24         42  
  24         174  
5 24     24   100011 use Moose::Util::TypeConstraints;
  24         47  
  24         202  
6 24     24   36674 use Devel::Declare ();
  24         37  
  24         401  
7 24     24   96 use Sub::Install qw( install_sub );
  24         29  
  24         214  
8 24     24   1983 use Moose::Meta::Class ();
  24         37  
  24         438  
9 24     24   93 use List::MoreUtils qw( uniq );
  24         37  
  24         225  
10 24     24   7183 use Module::Runtime 'use_module';
  24         39  
  24         170  
11              
12 24     24   1085 use aliased 'MooseX::Declare::Context';
  24         39  
  24         164  
13              
14 24     24   2595 use namespace::clean -except => 'meta';
  24         45  
  24         236  
15              
16             #pod =head1 DESCRIPTION
17             #pod
18             #pod This role provides the functionality common for all keyword handlers
19             #pod in L<MooseX::Declare>.
20             #pod
21             #pod =head1 REQUIRED METHODS
22             #pod
23             #pod =head2 parse
24             #pod
25             #pod Object->parse (Object $context)
26             #pod
27             #pod This method must implement the actual parsing of the keyword syntax.
28             #pod
29             #pod =cut
30              
31             requires qw(
32             parse
33             );
34              
35             #pod =attr identifier
36             #pod
37             #pod This is the name of the actual keyword. It is a required string that is in
38             #pod the same format as a usual Perl identifier.
39             #pod
40             #pod =cut
41              
42             has identifier => (
43             is => 'ro',
44             isa => subtype(as 'Str', where { /^ [_a-z] [_a-z0-9]* $/ix }),
45             required => 1,
46             );
47              
48             #pod =method get_identifier
49             #pod
50             #pod Str Object->get_identifier ()
51             #pod
52             #pod Returns the name the handler will be setup under.
53             #pod
54             #pod =cut
55              
56 879     879 1 32287 sub get_identifier { shift->identifier }
57              
58 129     129 0 338 sub context_class { Context }
59              
60 66     66 0 481 sub context_traits { }
61              
62             #pod =method setup_for
63             #pod
64             #pod Object->setup_for (ClassName $class, %args)
65             #pod
66             #pod This will setup the handler in the specified C<$class>. The handler will
67             #pod dispatch to the L</parse_declaration> method when the keyword is used.
68             #pod
69             #pod A normal code reference will also be exported into the calling namespace.
70             #pod It will either be empty or, if a C<generate_export> method is provided,
71             #pod the return value of that method.
72             #pod
73             #pod =cut
74              
75             sub setup_for {
76 749     749 1 3042 my ($self, $setup_class, %args) = @_;
77              
78             # make sure the stack is valid
79 749   100     1907 my $stack = $args{stack} || [];
80 749         1501 my $ident = $self->get_identifier;
81              
82             # setup the D:D handler for our keyword
83             Devel::Declare->setup_for($setup_class, {
84             $ident => {
85 129     129   2088375 const => sub { $self->parse_declaration((caller(1))[1], \%args, @_) },
86             },
87 749         6641 });
88              
89             # search or generate a real export
90 749 100   5   17311 my $export = $self->can('generate_export') ? $self->generate_export($setup_class) : sub { };
  5         29  
91              
92             # export subroutine
93 749 100       7761 install_sub({
94             code => $export,
95             into => $setup_class,
96             as => $ident,
97             }) unless $setup_class->can($ident);
98              
99 749         46658 return 1;
100             }
101              
102             #pod =method parse_declaration
103             #pod
104             #pod Object->parse_declaration (Str $filename, HashRef $setup_args, @call_args)
105             #pod
106             #pod This simply creates a new L<context|MooseX::Declare::Context> and passes it
107             #pod to the L</parse> method.
108             #pod
109             #pod =cut
110              
111             sub parse_declaration {
112 129     129 1 405 my ($self, $caller_file, $args, @ctx_args) = @_;
113              
114             # find and load context object class
115 129         552 my $ctx_class = $self->context_class;
116 129         560 use_module $ctx_class;
117              
118             # do we have traits?
119 129 100       4319 if (my @ctx_traits = uniq $self->context_traits) {
120              
121             use_module $_
122 73         1128 for @ctx_traits;
123              
124 73         3100 $ctx_class = Moose::Meta::Class->create_anon_class(
125             superclasses => [$ctx_class],
126             roles => [@ctx_traits],
127             cache => 1,
128             )->name;
129             }
130              
131             # create a context object and initialize it
132 129         1520 my $ctx = $ctx_class->new(
133 129         41685 %{ $args },
134             caller_file => $caller_file,
135             );
136 129         1473 $ctx->init(@ctx_args);
137              
138             # parse with current context
139 129         3817 return $self->parse($ctx);
140             }
141              
142             #pod =head1 SEE ALSO
143             #pod
144             #pod =for :list
145             #pod * L<MooseX::Declare>
146             #pod * L<MooseX::Declare::Context>
147             #pod
148             #pod =cut
149              
150             1;
151              
152             __END__
153              
154             =pod
155              
156             =encoding UTF-8
157              
158             =head1 NAME
159              
160             MooseX::Declare::Syntax::KeywordHandling - Basic keyword functionality
161              
162             =head1 VERSION
163              
164             version 0.40
165              
166             =head1 DESCRIPTION
167              
168             This role provides the functionality common for all keyword handlers
169             in L<MooseX::Declare>.
170              
171             =head1 ATTRIBUTES
172              
173             =head2 identifier
174              
175             This is the name of the actual keyword. It is a required string that is in
176             the same format as a usual Perl identifier.
177              
178             =head1 METHODS
179              
180             =head2 get_identifier
181              
182             Str Object->get_identifier ()
183              
184             Returns the name the handler will be setup under.
185              
186             =head2 setup_for
187              
188             Object->setup_for (ClassName $class, %args)
189              
190             This will setup the handler in the specified C<$class>. The handler will
191             dispatch to the L</parse_declaration> method when the keyword is used.
192              
193             A normal code reference will also be exported into the calling namespace.
194             It will either be empty or, if a C<generate_export> method is provided,
195             the return value of that method.
196              
197             =head2 parse_declaration
198              
199             Object->parse_declaration (Str $filename, HashRef $setup_args, @call_args)
200              
201             This simply creates a new L<context|MooseX::Declare::Context> and passes it
202             to the L</parse> method.
203              
204             =head1 REQUIRED METHODS
205              
206             =head2 parse
207              
208             Object->parse (Object $context)
209              
210             This method must implement the actual parsing of the keyword syntax.
211              
212             =head1 SEE ALSO
213              
214             =over 4
215              
216             =item *
217              
218             L<MooseX::Declare>
219              
220             =item *
221              
222             L<MooseX::Declare::Context>
223              
224             =back
225              
226             =head1 AUTHOR
227              
228             Florian Ragwitz <rafl@debian.org>
229              
230             =head1 COPYRIGHT AND LICENSE
231              
232             This software is copyright (c) 2008 by Florian Ragwitz.
233              
234             This is free software; you can redistribute it and/or modify it under
235             the same terms as the Perl 5 programming language system itself.
236              
237             =cut