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