Commit | Line | Data |
9baf5d6b |
1 | #!/usr/bin/env perl |
c3398f5b |
2 | package Mouse; |
3 | use strict; |
4 | use warnings; |
5 | |
ed00ef38 |
6 | our $VERSION = '0.06'; |
126765f0 |
7 | use 5.006; |
c3398f5b |
8 | |
9 | use Sub::Exporter; |
10 | use Carp 'confess'; |
11 | use Scalar::Util 'blessed'; |
8517d2ff |
12 | use Class::Method::Modifiers (); |
c3398f5b |
13 | |
306290e8 |
14 | use Mouse::Meta::Attribute; |
15 | use Mouse::Meta::Class; |
c3398f5b |
16 | use Mouse::Object; |
d60c78b9 |
17 | use Mouse::TypeRegistry; |
c3398f5b |
18 | |
19 | do { |
20 | my $CALLER; |
21 | |
22 | my %exports = ( |
23 | meta => sub { |
306290e8 |
24 | my $meta = Mouse::Meta::Class->initialize($CALLER); |
c3398f5b |
25 | return sub { $meta }; |
26 | }, |
27 | |
28 | extends => sub { |
29 | my $caller = $CALLER; |
30 | return sub { |
31 | $caller->meta->superclasses(@_); |
32 | }; |
33 | }, |
34 | |
35 | has => sub { |
724c77c0 |
36 | my $caller = $CALLER; |
37 | |
c3398f5b |
38 | return sub { |
724c77c0 |
39 | my $meta = $caller->meta; |
40 | |
c3398f5b |
41 | my $names = shift; |
42 | $names = [$names] if !ref($names); |
43 | |
44 | for my $name (@$names) { |
1bfebf5f |
45 | if ($name =~ s/^\+//) { |
724c77c0 |
46 | Mouse::Meta::Attribute->clone_parent($meta, $name, @_); |
1bfebf5f |
47 | } |
48 | else { |
724c77c0 |
49 | Mouse::Meta::Attribute->create($meta, $name, @_); |
1bfebf5f |
50 | } |
c3398f5b |
51 | } |
52 | }; |
53 | }, |
54 | |
55 | confess => sub { |
b17094ce |
56 | return \&confess; |
c3398f5b |
57 | }, |
58 | |
59 | blessed => sub { |
b17094ce |
60 | return \&blessed; |
c3398f5b |
61 | }, |
8517d2ff |
62 | |
63 | before => sub { |
64 | return \&Class::Method::Modifiers::before; |
65 | }, |
66 | |
67 | after => sub { |
68 | return \&Class::Method::Modifiers::after; |
69 | }, |
70 | |
71 | around => sub { |
72 | return \&Class::Method::Modifiers::around; |
73 | }, |
3ab0ee8f |
74 | |
75 | with => sub { |
76 | my $caller = $CALLER; |
77 | |
78 | return sub { |
79 | my $role = shift; |
80 | my $class = $caller->meta; |
81 | |
e5f31f1f |
82 | confess "Mouse::Role only supports 'with' on individual roles at a time" if @_; |
e7dff5dc |
83 | |
3ab0ee8f |
84 | Mouse::load_class($role); |
da0c885d |
85 | $role->meta->apply($class); |
3ab0ee8f |
86 | }; |
87 | }, |
c3398f5b |
88 | ); |
89 | |
90 | my $exporter = Sub::Exporter::build_exporter({ |
91 | exports => \%exports, |
92 | groups => { default => [':all'] }, |
93 | }); |
94 | |
95 | sub import { |
96 | $CALLER = caller; |
97 | |
98 | strict->import; |
99 | warnings->import; |
100 | |
306290e8 |
101 | my $meta = Mouse::Meta::Class->initialize($CALLER); |
ca73a208 |
102 | $meta->superclasses('Mouse::Object') |
103 | unless $meta->superclasses; |
c3398f5b |
104 | |
105 | goto $exporter; |
106 | } |
107 | |
108 | sub unimport { |
109 | my $caller = caller; |
110 | |
111 | no strict 'refs'; |
112 | for my $keyword (keys %exports) { |
113 | next if $keyword eq 'meta'; # we don't delete this one |
114 | delete ${ $caller . '::' }{$keyword}; |
115 | } |
116 | } |
117 | }; |
118 | |
119 | sub load_class { |
120 | my $class = shift; |
262801ef |
121 | |
9694b71b |
122 | if (ref($class) || !defined($class) || !length($class)) { |
123 | my $display = defined($class) ? $class : 'undef'; |
124 | confess "Invalid class name ($display)"; |
125 | } |
c3398f5b |
126 | |
2a674d23 |
127 | return 1 if is_class_loaded($class); |
128 | |
c3398f5b |
129 | (my $file = "$class.pm") =~ s{::}{/}g; |
130 | |
131 | eval { CORE::require($file) }; |
2a674d23 |
132 | confess "Could not load class ($class) because : $@" if $@; |
c3398f5b |
133 | |
134 | return 1; |
135 | } |
136 | |
2a674d23 |
137 | sub is_class_loaded { |
138 | my $class = shift; |
139 | |
7ecc2123 |
140 | return 0 if ref($class) || !defined($class) || !length($class); |
141 | |
bf134049 |
142 | # walk the symbol table tree to avoid autovififying |
143 | # \*{${main::}{"Foo::"}} == \*main::Foo:: |
144 | |
145 | my $pack = \*::; |
146 | foreach my $part (split('::', $class)) { |
147 | return 0 unless exists ${$$pack}{"${part}::"}; |
148 | $pack = \*{${$$pack}{"${part}::"}}; |
2a674d23 |
149 | } |
bf134049 |
150 | |
151 | # check for $VERSION or @ISA |
152 | return 1 if exists ${$$pack}{VERSION} |
153 | && defined *{${$$pack}{VERSION}}{SCALAR}; |
154 | return 1 if exists ${$$pack}{ISA} |
155 | && defined *{${$$pack}{ISA}}{ARRAY}; |
156 | |
157 | # check for any method |
158 | foreach ( keys %{$$pack} ) { |
159 | next if substr($_, -2, 2) eq '::'; |
160 | return 1 if defined *{${$$pack}{$_}}{CODE}; |
161 | } |
162 | |
163 | # fail |
2a674d23 |
164 | return 0; |
165 | } |
166 | |
c3398f5b |
167 | 1; |
168 | |
169 | __END__ |
170 | |
171 | =head1 NAME |
172 | |
0fff36e6 |
173 | Mouse - Moose minus the antlers |
c3398f5b |
174 | |
c3398f5b |
175 | =head1 SYNOPSIS |
176 | |
177 | package Point; |
6caea456 |
178 | use Mouse; # automatically turns on strict and warnings |
179 | |
180 | has 'x' => (is => 'rw', isa => 'Int'); |
181 | has 'y' => (is => 'rw', isa => 'Int'); |
182 | |
183 | sub clear { |
184 | my $self = shift; |
185 | $self->x(0); |
186 | $self->y(0); |
187 | } |
188 | |
189 | package Point3D; |
c3398f5b |
190 | use Mouse; |
191 | |
6caea456 |
192 | extends 'Point'; |
c3398f5b |
193 | |
6caea456 |
194 | has 'z' => (is => 'rw', isa => 'Int'); |
195 | |
8517d2ff |
196 | after 'clear' => sub { |
197 | my $self = shift; |
198 | $self->z(0); |
199 | }; |
c3398f5b |
200 | |
201 | =head1 DESCRIPTION |
202 | |
0fff36e6 |
203 | L<Moose> is wonderful. |
c3398f5b |
204 | |
0fff36e6 |
205 | Unfortunately, it's a little slow. Though significant progress has been made |
206 | over the years, the compile time penalty is a non-starter for some |
207 | applications. |
208 | |
209 | Mouse aims to alleviate this by providing a subset of Moose's |
210 | functionality, faster. In particular, L<Moose/has> is missing only a few |
211 | expert-level features. |
212 | |
213 | =head2 MOOSE COMPAT |
214 | |
215 | Compatibility with Moose has been the utmost concern. Fewer than 1% of the |
216 | tests fail when run against Moose instead of Mouse. Mouse code coverage is also |
faa5cb70 |
217 | over 97%. Even the error messages are taken from Moose. The Mouse code just |
8e1a28a8 |
218 | runs the test suite 3x-4x faster. |
0fff36e6 |
219 | |
220 | The idea is that, if you need the extra power, you should be able to run |
8e1a28a8 |
221 | C<s/Mouse/Moose/g> on your codebase and have nothing break. To that end, |
222 | nothingmuch has written L<Squirrel> (part of this distribution) which will act |
223 | as Mouse unless Moose is loaded, in which case it will act as Moose. |
0fff36e6 |
224 | |
225 | Mouse also has the blessings of Moose's author, stevan. |
226 | |
227 | =head2 MISSING FEATURES |
228 | |
0fff36e6 |
229 | =head3 Roles |
230 | |
faa5cb70 |
231 | We're working on fixing this one! stevan has suggested an implementation |
232 | strategy. Mouse currently ignores methods, so that needs to be fixed next. |
233 | Roles that consist entirely of attributes may be usable in this very version. |
0fff36e6 |
234 | |
235 | =head3 Complex types |
236 | |
237 | User-defined type constraints and parameterized types may be implemented. Type |
238 | coercions probably not (patches welcome). |
239 | |
240 | =head3 Bootstrapped meta world |
241 | |
242 | Very handy for extensions to the MOP. Not pressing, but would be nice to have. |
243 | |
244 | =head3 Modification of attribute metaclass |
245 | |
246 | When you declare an attribute with L</has>, you get the inlined accessors |
247 | installed immediately. Modifying the attribute metaclass, even if possible, |
248 | does nothing. |
249 | |
250 | =head3 Lots more.. |
251 | |
252 | MouseX? |
253 | |
254 | =head1 KEYWORDS |
c3398f5b |
255 | |
306290e8 |
256 | =head2 meta -> Mouse::Meta::Class |
c3398f5b |
257 | |
258 | Returns this class' metaclass instance. |
259 | |
260 | =head2 extends superclasses |
261 | |
262 | Sets this class' superclasses. |
263 | |
b7a74822 |
264 | =head2 before (method|methods) => Code |
265 | |
266 | Installs a "before" method modifier. See L<Moose/before> or |
267 | L<Class::Method::Modifiers/before>. |
268 | |
269 | =head2 after (method|methods) => Code |
270 | |
271 | Installs an "after" method modifier. See L<Moose/after> or |
272 | L<Class::Method::Modifiers/after>. |
273 | |
274 | =head2 around (method|methods) => Code |
275 | |
276 | Installs an "around" method modifier. See L<Moose/around> or |
277 | L<Class::Method::Modifiers/around>. |
278 | |
c3398f5b |
279 | =head2 has (name|names) => parameters |
280 | |
281 | Adds an attribute (or if passed an arrayref of names, multiple attributes) to |
0fff36e6 |
282 | this class. Options: |
283 | |
284 | =over 4 |
285 | |
286 | =item is => ro|rw |
287 | |
288 | If specified, inlines a read-only/read-write accessor with the same name as |
289 | the attribute. |
290 | |
291 | =item isa => TypeConstraint |
292 | |
293 | Provides basic type checking in the constructor and accessor. Basic types such |
294 | as C<Int>, C<ArrayRef>, C<Defined> are supported. Any unknown type is taken to |
295 | be a class check (e.g. isa => 'DateTime' would accept only L<DateTime> |
296 | objects). |
297 | |
298 | =item required => 0|1 |
299 | |
300 | Whether this attribute is required to have a value. If the attribute is lazy or |
301 | has a builder, then providing a value for the attribute in the constructor is |
302 | optional. |
303 | |
304 | =item init_arg => Str |
305 | |
306 | Allows you to use a different key name in the constructor. |
307 | |
308 | =item default => Value | CodeRef |
309 | |
310 | Sets the default value of the attribute. If the default is a coderef, it will |
311 | be invoked to get the default value. Due to quirks of Perl, any bare reference |
312 | is forbidden, you must wrap the reference in a coderef. Otherwise, all |
313 | instances will share the same reference. |
314 | |
315 | =item lazy => 0|1 |
316 | |
317 | If specified, the default is calculated on demand instead of in the |
318 | constructor. |
319 | |
320 | =item predicate => Str |
321 | |
322 | Lets you specify a method name for installing a predicate method, which checks |
323 | that the attribute has a value. It will not invoke a lazy default or builder |
324 | method. |
325 | |
326 | =item clearer => Str |
327 | |
328 | Lets you specify a method name for installing a clearer method, which clears |
329 | the attribute's value from the instance. On the next read, lazy or builder will |
330 | be invoked. |
331 | |
332 | =item handles => HashRef|ArrayRef |
333 | |
334 | Lets you specify methods to delegate to the attribute. ArrayRef forwards the |
335 | given method names to method calls on the attribute. HashRef maps local method |
336 | names to remote method names called on the attribute. Other forms of |
337 | L</handles>, such as regular expression and coderef, are not yet supported. |
338 | |
339 | =item weak_ref => 0|1 |
340 | |
341 | Lets you automatically weaken any reference stored in the attribute. |
342 | |
84357c9a |
343 | =item trigger => CodeRef | HashRef |
344 | |
345 | Triggers are like method modifiers for setting attribute values. You can have |
346 | a "before" and an "after" trigger, each of which receive as arguments the instance, the new value, and the attribute metaclass. Historically, triggers have |
347 | only been "after" modifiers, so if you use a coderef for the C<trigger> option, |
348 | it will maintain that compatibility. Like method modifiers, you can't really |
349 | affect the act of setting the attribute value, and the return values of the |
350 | modifiers are ignored. |
351 | |
352 | There's also an "around" trigger which you can use to change the value that |
353 | is being set on the attribute, or even prevent the attribute from being |
354 | updated. The around trigger receives as arguments a code reference to invoke |
355 | to set the attribute's value (which expects as arguments the instance and |
356 | the new value), the instance, the new value, and the attribute metaclass. |
0fff36e6 |
357 | |
358 | =item builder => Str |
359 | |
360 | Defines a method name to be called to provide the default value of the |
361 | attribute. C<< builder => 'build_foo' >> is mostly equivalent to |
362 | C<< default => sub { $_[0]->build_foo } >>. |
363 | |
364 | =item auto_deref => 0|1 |
365 | |
366 | Allows you to automatically dereference ArrayRef and HashRef attributes in list |
367 | context. In scalar context, the reference is returned (NOT the list length or |
368 | bucket status). You must specify an appropriate type constraint to use |
369 | auto_deref. |
370 | |
371 | =back |
c3398f5b |
372 | |
373 | =head2 confess error -> BOOM |
374 | |
375 | L<Carp/confess> for your convenience. |
376 | |
377 | =head2 blessed value -> ClassName | undef |
378 | |
379 | L<Scalar::Util/blessed> for your convenience. |
380 | |
381 | =head1 MISC |
382 | |
383 | =head2 import |
384 | |
6caea456 |
385 | Importing Mouse will default your class' superclass list to L<Mouse::Object>. |
c3398f5b |
386 | You may use L</extends> to replace the superclass list. |
387 | |
388 | =head2 unimport |
389 | |
0fff36e6 |
390 | Please unimport Mouse (C<no Mouse>) so that if someone calls one of the |
391 | keywords (such as L</extends>) it will break loudly instead breaking subtly. |
c3398f5b |
392 | |
393 | =head1 FUNCTIONS |
394 | |
395 | =head2 load_class Class::Name |
396 | |
6caea456 |
397 | This will load a given C<Class::Name> (or die if it's not loadable). |
c3398f5b |
398 | This function can be used in place of tricks like |
399 | C<eval "use $module"> or using C<require>. |
400 | |
262801ef |
401 | =head2 is_class_loaded Class::Name -> Bool |
402 | |
403 | Returns whether this class is actually loaded or not. It uses a heuristic which |
404 | involves checking for the existence of C<$VERSION>, C<@ISA>, and any |
405 | locally-defined method. |
406 | |
c3398f5b |
407 | =head1 AUTHOR |
408 | |
409 | Shawn M Moore, C<< <sartak at gmail.com> >> |
410 | |
0fff36e6 |
411 | with plenty of code borrowed from L<Class::MOP> and L<Moose> |
412 | |
c3398f5b |
413 | =head1 BUGS |
414 | |
415 | No known bugs. |
416 | |
417 | Please report any bugs through RT: email |
418 | C<bug-mouse at rt.cpan.org>, or browse |
419 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>. |
420 | |
421 | =head1 COPYRIGHT AND LICENSE |
422 | |
423 | Copyright 2008 Shawn M Moore. |
424 | |
425 | This program is free software; you can redistribute it and/or modify it |
426 | under the same terms as Perl itself. |
427 | |
428 | =cut |
429 | |