File Coverage

blib/lib/MooseX/DeclareX.pm
Criterion Covered Total %
statement 27 29 93.1
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 37 39 94.8


line stmt bran cond sub pod time code
1             package MooseX::DeclareX;
2              
3 7     7   169309 use 5.010;
  7         30  
  7         278  
4 7     7   39 use strict;
  7         12  
  7         255  
5 7     7   40 use warnings;
  7         19  
  7         211  
6 7     7   12726 use utf8;
  7         77  
  7         36  
7              
8             BEGIN {
9 7     7   429 $MooseX::DeclareX::AUTHORITY = 'cpan:TOBYINK';
10 7         189 $MooseX::DeclareX::VERSION = '0.009';
11             }
12              
13 7     7   41 use constant DEFAULT_KEYWORDS => [qw(class role exception)];
  7         11  
  7         739  
14 7     7   40 use constant DEFAULT_PLUGINS => [qw(build guard std_constants)];
  7         12  
  7         357  
15              
16 7     7   8120 use Class::Load 0 qw(load_class);
  7         301597  
  7         478  
17 7     7   66 use Data::OptList 0;
  7         122  
  7         55  
18 7     7   11359 use MooseX::Declare 0;
  0            
  0            
19             use TryCatch 0;
20              
21             sub import
22             {
23             my ($class, %args) = @_;
24             my $caller = caller(0);
25              
26             # Simplified interface for a couple of standard plugins
27             foreach my $awesome (qw/ types imports /)
28             {
29             if (my $ness = delete $args{$awesome})
30             {
31             $args{plugins} ||= DEFAULT_PLUGINS;
32             push @{ $args{plugins} }, $awesome, $ness;
33             }
34             }
35              
36             $_->setup_for($caller, %args, provided_by => $class) for __PACKAGE__->_keywords(\%args);
37            
38             strict->import;
39             warnings->import;
40             TryCatch->import({ into => $caller });
41             }
42              
43             sub _keywords
44             {
45             my ($class, $args) = @_;
46             my @return;
47            
48             my $kinds = Data::OptList::mkopt( $args->{keywords} || DEFAULT_KEYWORDS );
49             foreach my $pair (@$kinds)
50             {
51             my ($class, $opts) = @$pair;
52             $opts //= {};
53            
54             load_class(
55             my $module = join '::' => qw[MooseX DeclareX Keyword], $class
56             );
57            
58             my $kw = $module->new( $opts->{init} ? $opts->{init} : (identifier => $class) );
59             push @return, $kw;
60            
61             my $plugins = Data::OptList::mkopt(
62             $opts->{plugins} || $args->{plugins} || DEFAULT_PLUGINS,
63             );
64            
65             foreach my $pair2 (@$plugins)
66             {
67             no warnings;
68             my ($class2, $opts2) = @$pair2;
69             next if $class2 =~ qr(
70             method | before | after | around | override | augment
71             | with | is | clean | dirty | mutable | try | catch
72             )x;
73             use warnings;
74            
75             my $module2 = join '::' => (qw[MooseX DeclareX Plugin], $class2);
76             $module2 =~ s/Plugin::concrete$/Plugin::abstract/;
77             load_class $module2;
78            
79             $module2->plugin_setup($kw, $opts2);
80             }
81             }
82            
83             return @return;
84             }
85              
86             "Would you like some tea with that sugar?"
87              
88             __END__
89              
90             =head1 NAME
91              
92             MooseX::DeclareX - more sugar for MooseX::Declare
93              
94             =head1 SYNOPSIS
95              
96             use 5.010;
97             use MooseX::DeclareX
98             keywords => [qw(class exception)],
99             plugins => [qw(guard build preprocess std_constants)],
100             types => [ -Moose ];
101            
102             class Banana;
103            
104             exception BananaError
105             {
106             has origin => (
107             is => read_write,
108             isa => Object,
109             required => true,
110             );
111             }
112            
113             class Monkey
114             {
115             has name => (
116             is => read_write,
117             isa => Str,
118             );
119            
120             build name {
121             state $i = 1;
122             return "Anonymous $i";
123             }
124            
125             has bananas => (
126             is => read_write,
127             isa => ArrayRef[ Object ],
128             traits => ['Array'],
129             handles => {
130             give_banana => 'push',
131             eat_banana => 'shift',
132             lose_bananas => 'clear',
133             got_bananas => 'count',
134             },
135             );
136            
137             build bananas {
138             return [];
139             }
140            
141             guard eat_banana {
142             $self->got_bananas or BananaError->throw(
143             origin => $self,
144             message => "We have no bananas today!",
145             );
146             }
147            
148             after lose_bananas {
149             $self->screech("Oh no!");
150             }
151              
152             method screech (@strings) {
153             my $name = $self->name;
154             say "$name: $_" for @strings;
155             }
156             }
157            
158             class Monkey::Loud extends Monkey
159             {
160             preprocess screech (@strings) {
161             return map { uc($_) } @strings;
162             }
163             }
164            
165             try {
166             my $bobo = Monkey::Loud->new;
167             $bobo->give_banana( Banana->new );
168             $bobo->lose_bananas;
169             $bobo->give_banana( Banana->new );
170             $bobo->eat_banana;
171             $bobo->eat_banana;
172             }
173             catch (BananaError $e) {
174             warn sprintf("%s: %s\n", ref $e, $e->message);
175             }
176              
177             =head1 STATUS
178              
179             This is very experimental stuff. B<< YOU HAVE BEEN WARNED! >>
180              
181             =head1 DESCRIPTION
182              
183             MooseX::DeclareX takes the declarative sugar of L<MooseX::Declare> to the
184             next level. Some people already consider MooseX::Declare to be pretty insane.
185             If you're one of those people, then you're not going to like this...
186              
187             =head2 Keywords
188              
189             =over
190              
191             =item C<class>, C<role>, C<extends>, C<with>, C<< is dirty >>, C<< is mutable >>, C<clean>.
192              
193             Inherited from L<MooseX::Declare>.
194              
195             =item C<method>, C<around>, C<before>, C<after>, C<override>, C<augment>
196              
197             Inherited from L<MooseX::Method::Signatures>.
198              
199             =item C<try>, C<catch>
200              
201             Inherited from L<TryCatch>.
202              
203             =item C<exception>
204              
205             C<< exception Foo >> is sugar for C<< class Foo extends Throwable::Error >>.
206             That is, it creates a class which is a subclass of L<Throwable::Error>.
207              
208             =item C<build>
209              
210             This is some sugar for creating builder methods. The following two examples
211             are roughly equivalent:
212              
213             build fullname {
214             join q( ), $self->firstname, $self->surname;
215             }
216              
217             sub _build_fullname {
218             my $self = shift;
219             join q( ), $self->firstname, $self->surname;
220             }
221              
222             However, C<build> also performs a little housekeeping for you. If an attribute
223             does not exist with the same name as the builder, it will create one for you
224             (which will be read-only, with type constraint "Any" unless C<build> can detect
225             a more specific type constraint from the method's return signature). If the
226             attribute already exists but does not have a builder set, then it will set it.
227              
228             =item C<guard>
229              
230             Simplifies a common usage pattern for C<around>. A guard protects a method,
231             preventing it from being called unless a condition evaluates to true.
232              
233             class Doorway
234             {
235             method enter ($person)
236             {
237             ...
238             }
239             }
240            
241             class Doorway::Protected
242             {
243             has password => (is => 'ro', isa => 'Str');
244            
245             guard enter ($person)
246             {
247             $person->knows( $self->password )
248             }
249             }
250              
251             =item C<preprocess>
252              
253             Another simplification for a common usage pattern for C<around>. Acts much
254             like C<before>, but B<can> modify the parameters seen by the base method.
255             In fact, it must return the processed parameters as a list.
256              
257             class Speaker
258             {
259             method speak (@words) {
260             say for @words;
261             }
262             }
263            
264             class Speaker::Loud
265             {
266             preprocess speak {
267             return map { uc($_) } @_
268             }
269             }
270              
271             =item C<postprocess>
272              
273             Like C<preprocess> but instead acts on the method's return value.
274              
275             =item C<read_only>, C<read_write>, C<true>, C<false>
276              
277             Useful constants when defining Moose attributes. These are enabled by the
278             std_constants plugin.
279              
280             =back
281              
282             =head2 Export
283              
284             You should indicate which features you are using:
285              
286             use MooseX::DeclareX
287             keywords => [qw(class role exception)],
288             plugins => [qw(guard build)];
289              
290             What is the distinction between keywords and plugins? Keywords are the words
291             that declare class-like things. Plugins are the other bits, and only work
292             B<inside> the class-like declarations.
293              
294             Things inherited from MooseX::Declare and MooseX::Method::Signatures do not
295             need to be indicated; they are always loaded. Things inherited from TryCatch
296             do not need to be indicated; they are available outside class declarations
297             too.
298              
299             If you don't specify a list of keywords, then the default list is:
300              
301             [qw(class role exception)]
302              
303             If you don't specify a list of plugins, then the default list is:
304              
305             [qw(build guard std_constants)]
306              
307             That is, there are certain pieces of functionality which are not available
308             by default - they need to be loaded explicitly!
309              
310             =head2 MooseX::Types
311              
312             You can inject a bunch of MooseX::Types keywords into all classes quite
313             easily:
314              
315             use MooseX::DeclareX
316             keywords => [qw(class role exception)],
317             plugins => [qw(build std_constants)],
318             types => [
319             -Moose, # use MooseX::Types::Moose -all
320             -URI => [qw(FileUri)], # use MooseX::Types::URI qw(FileUri)
321             'Foo::Types', # use Foo::Types -all
322             ];
323              
324             As per the example, any module which does not include an arrayref of import
325             parameters, gets "-all". A leading hyphen is interpreted as an abbreviation
326             for "MooseX::Types::".
327              
328             =head2 Additional Import Syntactic Sugar
329              
330             You can specify a list of additional modules that will always be imported
331             "inside" your class/role definitions.
332              
333             use MooseX::DeclareX
334             keywords => [qw(class role exception)],
335             plugins => [qw(build guard std_constants)],
336             imports => [
337             'MooseX::ClassAttribute',
338             'Path::Class' => [qw( file dir )],
339             'Perl6::Junction' => [qw( any all none )],
340             'List::Util' => [qw( first reduce )],
341             ];
342              
343             In fact, this is just a minor generalisation of the MooseX::Types feature.
344              
345             =head1 BUGS
346              
347             Please report any bugs to
348             L<http://rt.cpan.org/Dist/Display.html?Queue=MooseX-DeclareX>.
349              
350             =head1 SEE ALSO
351              
352             L<MooseX::Declare>, L<MooseX::Method::Signatures>, L<TryCatch>,
353             L<Throwable::Error>, L<MooseX::Types>.
354              
355             Additional keywords and plugins are available on CPAN:
356             L<MooseX::DeclareX::Plugin::abstract>,
357             L<MooseX::DeclareX::Privacy>,
358             L<MooseX::DeclareX::Keyword::interface>,
359             L<MooseX::DeclareX::Plugin::singleton>.
360              
361             =head1 AUTHOR
362              
363             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
364              
365             =head1 COPYRIGHT AND LICENCE
366              
367             This software is copyright (c) 2012 by Toby Inkster.
368              
369             This is free software; you can redistribute it and/or modify it under
370             the same terms as the Perl 5 programming language system itself.
371              
372             =head1 DISCLAIMER OF WARRANTIES
373              
374             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
375             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
376             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
377