10 if ($ENV{MOUSE_DEBUG}) {
18 use Scalar::Util 'blessed';
21 use Mouse::Meta::Attribute;
22 use Mouse::Meta::Class;
24 use Mouse::Util::TypeConstraints;
26 our @EXPORT = qw(extends has before after around override super blessed confess with);
28 sub extends { Mouse::Meta::Class->initialize(caller)->superclasses(@_) }
31 my $meta = Mouse::Meta::Class->initialize(caller);
34 $names = [$names] if !ref($names);
35 my $metaclass = 'Mouse::Meta::Attribute';
38 if ( my $metaclass_name = delete $options{metaclass} ) {
39 my $new_class = Mouse::Util::resolve_metaclass_alias(
43 if ( $metaclass ne $new_class ) {
44 $metaclass = $new_class;
48 for my $name (@$names) {
49 if ($name =~ s/^\+//) {
50 $metaclass->clone_parent($meta, $name, @_);
53 $metaclass->create($meta, $name, @_);
59 my $meta = Mouse::Meta::Class->initialize(caller);
64 $meta->add_before_method_modifier($_ => $code);
69 my $meta = Mouse::Meta::Class->initialize(caller);
74 $meta->add_after_method_modifier($_ => $code);
79 my $meta = Mouse::Meta::Class->initialize(caller);
84 $meta->add_around_method_modifier($_ => $code);
89 Mouse::Util::apply_all_roles((caller)[0], @_);
97 # This check avoids a recursion loop - see
98 # t/100_bugs/020_super_recursion.t
99 return if defined $SUPER_PACKAGE && $SUPER_PACKAGE ne caller();
100 return unless $SUPER_BODY; $SUPER_BODY->(@SUPER_ARGS);
104 my $meta = Mouse::Meta::Class->initialize(caller);
105 my $pkg = $meta->name;
110 my $body = $pkg->can($name)
111 or confess "You cannot override '$name' because it has no super method";
113 $meta->add_method($name => sub {
114 local $SUPER_PACKAGE = $pkg;
115 local @SUPER_ARGS = @_;
116 local $SUPER_BODY = $body;
130 # we should never export to main
131 if ($caller eq 'main') {
132 warn qq{$class does not export its sugar to the 'main' package.\n};
136 my $meta = Mouse::Meta::Class->initialize($caller);
137 $meta->superclasses('Mouse::Object')
138 unless $meta->superclasses;
141 no warnings 'redefine';
142 *{$caller.'::meta'} = sub { $meta };
145 __PACKAGE__->export_to_level( 1, $class, @_);
147 # shortcut for the common case of no type character
149 for my $keyword (@EXPORT) {
150 *{ $caller . '::' . $keyword } = *{__PACKAGE__ . '::' . $keyword};
159 for my $keyword (@EXPORT) {
160 delete ${ $caller . '::' }{$keyword};
167 if (ref($class) || !defined($class) || !length($class)) {
168 my $display = defined($class) ? $class : 'undef';
169 confess "Invalid class name ($display)";
172 return 1 if $class eq 'Mouse::Object';
173 return 1 if is_class_loaded($class);
175 (my $file = "$class.pm") =~ s{::}{/}g;
177 eval { CORE::require($file) };
178 confess "Could not load class ($class) because : $@" if $@;
183 sub is_class_loaded {
186 return 0 if ref($class) || !defined($class) || !length($class);
188 # walk the symbol table tree to avoid autovififying
189 # \*{${main::}{"Foo::"}} == \*main::Foo::
192 foreach my $part (split('::', $class)) {
193 return 0 unless exists ${$$pack}{"${part}::"};
194 $pack = \*{${$$pack}{"${part}::"}};
197 # check for $VERSION or @ISA
198 return 1 if exists ${$$pack}{VERSION}
199 && defined *{${$$pack}{VERSION}}{SCALAR};
200 return 1 if exists ${$$pack}{ISA}
201 && defined *{${$$pack}{ISA}}{ARRAY};
203 # check for any method
204 foreach ( keys %{$$pack} ) {
205 next if substr($_, -2, 2) eq '::';
206 return 1 if defined *{${$$pack}{$_}}{CODE};
219 Mouse - Moose minus the antlers
224 use Mouse; # automatically turns on strict and warnings
226 has 'x' => (is => 'rw', isa => 'Int');
227 has 'y' => (is => 'rw', isa => 'Int');
240 has 'z' => (is => 'rw', isa => 'Int');
242 after 'clear' => sub {
249 L<Moose> is wonderful.
251 Unfortunately, it's a little slow. Though significant progress has been made
252 over the years, the compile time penalty is a non-starter for some
255 Mouse aims to alleviate this by providing a subset of Moose's
256 functionality, faster. In particular, L<Moose/has> is missing only a few
257 expert-level features.
259 We're also going as light on dependencies as possible.
260 L<Class::Method::Modifiers> or L<Data::Util> is required if you want support
261 for L</before>, L</after>, and L</around>.
265 Compatibility with Moose has been the utmost concern. Fewer than 1% of the
266 tests fail when run against Moose instead of Mouse. Mouse code coverage is also
267 over 96%. Even the error messages are taken from Moose. The Mouse code just
268 runs the test suite 4x faster.
270 The idea is that, if you need the extra power, you should be able to run
271 C<s/Mouse/Moose/g> on your codebase and have nothing break. To that end,
272 nothingmuch has written L<Squirrel> (part of this distribution) which will act
273 as Mouse unless Moose is loaded, in which case it will act as Moose.
274 L<Any::Moose> is a more high-tech L<Squirrel>.
278 Please don't copy MooseX code to MouseX. If you need extensions, you really
279 should upgrade to Moose. We don't need two parallel sets of extensions!
281 If you really must write a Mouse extension, please contact the Moose mailing
282 list or #moose on IRC beforehand.
286 =head2 meta -> Mouse::Meta::Class
288 Returns this class' metaclass instance.
290 =head2 extends superclasses
292 Sets this class' superclasses.
294 =head2 before (method|methods) => Code
296 Installs a "before" method modifier. See L<Moose/before> or
297 L<Class::Method::Modifiers/before>.
299 Use of this feature requires L<Class::Method::Modifiers>!
301 =head2 after (method|methods) => Code
303 Installs an "after" method modifier. See L<Moose/after> or
304 L<Class::Method::Modifiers/after>.
306 Use of this feature requires L<Class::Method::Modifiers>!
308 =head2 around (method|methods) => Code
310 Installs an "around" method modifier. See L<Moose/around> or
311 L<Class::Method::Modifiers/around>.
313 Use of this feature requires L<Class::Method::Modifiers>!
315 =head2 has (name|names) => parameters
317 Adds an attribute (or if passed an arrayref of names, multiple attributes) to
324 If specified, inlines a read-only/read-write accessor with the same name as
327 =item isa => TypeConstraint
329 Provides basic type checking in the constructor and accessor. Basic types such
330 as C<Int>, C<ArrayRef>, C<Defined> are supported. Any unknown type is taken to
331 be a class check (e.g. isa => 'DateTime' would accept only L<DateTime>
334 =item required => 0|1
336 Whether this attribute is required to have a value. If the attribute is lazy or
337 has a builder, then providing a value for the attribute in the constructor is
340 =item init_arg => Str | Undef
342 Allows you to use a different key name in the constructor. If undef, the
343 attribue can't be passed to the constructor.
345 =item default => Value | CodeRef
347 Sets the default value of the attribute. If the default is a coderef, it will
348 be invoked to get the default value. Due to quirks of Perl, any bare reference
349 is forbidden, you must wrap the reference in a coderef. Otherwise, all
350 instances will share the same reference.
354 If specified, the default is calculated on demand instead of in the
357 =item predicate => Str
359 Lets you specify a method name for installing a predicate method, which checks
360 that the attribute has a value. It will not invoke a lazy default or builder
365 Lets you specify a method name for installing a clearer method, which clears
366 the attribute's value from the instance. On the next read, lazy or builder will
369 =item handles => HashRef|ArrayRef
371 Lets you specify methods to delegate to the attribute. ArrayRef forwards the
372 given method names to method calls on the attribute. HashRef maps local method
373 names to remote method names called on the attribute. Other forms of
374 L</handles>, such as regular expression and coderef, are not yet supported.
376 =item weak_ref => 0|1
378 Lets you automatically weaken any reference stored in the attribute.
380 Use of this feature requires L<Scalar::Util>!
382 =item trigger => CodeRef
384 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.
386 Mouse 0.05 supported more complex triggers, but this behavior is now removed.
390 Defines a method name to be called to provide the default value of the
391 attribute. C<< builder => 'build_foo' >> is mostly equivalent to
392 C<< default => sub { $_[0]->build_foo } >>.
394 =item auto_deref => 0|1
396 Allows you to automatically dereference ArrayRef and HashRef attributes in list
397 context. In scalar context, the reference is returned (NOT the list length or
398 bucket status). You must specify an appropriate type constraint to use
401 =item lazy_build => 0|1
403 Automatically define lazy => 1 as well as builder => "_build_$attr", clearer =>
404 "clear_$attr', predicate => 'has_$attr' unless they are already defined.
408 =head2 confess error -> BOOM
410 L<Carp/confess> for your convenience.
412 =head2 blessed value -> ClassName | undef
414 L<Scalar::Util/blessed> for your convenience.
420 Importing Mouse will default your class' superclass list to L<Mouse::Object>.
421 You may use L</extends> to replace the superclass list.
425 Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
426 keywords (such as L</extends>) it will break loudly instead breaking subtly.
430 =head2 load_class Class::Name
432 This will load a given C<Class::Name> (or die if it's not loadable).
433 This function can be used in place of tricks like
434 C<eval "use $module"> or using C<require>.
436 =head2 is_class_loaded Class::Name -> Bool
438 Returns whether this class is actually loaded or not. It uses a heuristic which
439 involves checking for the existence of C<$VERSION>, C<@ISA>, and any
440 locally-defined method.
444 Shawn M Moore, C<< <sartak at gmail.com> >>
446 Yuval Kogman, C<< <nothingmuch at woobling.org> >>
452 with plenty of code borrowed from L<Class::MOP> and L<Moose>
458 Please report any bugs through RT: email
459 C<bug-mouse at rt.cpan.org>, or browse
460 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>.
462 =head1 COPYRIGHT AND LICENSE
464 Copyright 2008 Shawn M Moore.
466 This program is free software; you can redistribute it and/or modify it
467 under the same terms as Perl itself.