10 use Scalar::Util 'blessed';
13 use Mouse::Meta::Attribute;
14 use Mouse::Meta::Module; # class_of()
15 use Mouse::Meta::Class;
17 use Mouse::Util::TypeConstraints;
19 our @EXPORT = qw(extends has before after around override super blessed confess with);
21 our %is_removable = map{ $_ => undef } @EXPORT;
22 delete $is_removable{blessed};
23 delete $is_removable{confess};
25 sub extends { Mouse::Meta::Class->initialize(caller)->superclasses(@_) }
28 my $meta = Mouse::Meta::Class->initialize(caller);
29 $meta->add_attribute(@_);
33 my $meta = Mouse::Meta::Class->initialize(caller);
38 $meta->add_before_method_modifier($_ => $code);
43 my $meta = Mouse::Meta::Class->initialize(caller);
48 $meta->add_after_method_modifier($_ => $code);
53 my $meta = Mouse::Meta::Class->initialize(caller);
58 $meta->add_around_method_modifier($_ => $code);
63 Mouse::Util::apply_all_roles((caller)[0], @_);
71 # This check avoids a recursion loop - see
72 # t/100_bugs/020_super_recursion.t
73 return if defined $SUPER_PACKAGE && $SUPER_PACKAGE ne caller();
74 return unless $SUPER_BODY; $SUPER_BODY->(@SUPER_ARGS);
78 my $meta = Mouse::Meta::Class->initialize(caller);
79 my $pkg = $meta->name;
84 my $body = $pkg->can($name)
85 or confess "You cannot override '$name' because it has no super method";
87 $meta->add_method($name => sub {
88 local $SUPER_PACKAGE = $pkg;
89 local @SUPER_ARGS = @_;
90 local $SUPER_BODY = $body;
97 # This used to be called as a function. This hack preserves
98 # backwards compatibility.
99 if ( $_[0] ne __PACKAGE__ ) {
100 return __PACKAGE__->init_meta(
110 my $class = $args{for_class}
112 "Cannot call init_meta without specifying a for_class");
113 my $base_class = $args{base_class} || 'Mouse::Object';
114 my $metaclass = $args{metaclass} || 'Mouse::Meta::Class';
116 Carp::croak("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.")
117 unless $metaclass->isa('Mouse::Meta::Class');
119 # make a subtype for each Mouse class
121 unless find_type_constraint($class);
123 my $meta = $metaclass->initialize($class);
124 $meta->superclasses($base_class)
125 unless $meta->superclasses;
127 $meta->add_method(meta => sub{
128 return Mouse::Meta::Class->initialize(ref($_[0]) || $_[0]);
142 if (ref($_[0]) && ref($_[0]) eq 'HASH') {
148 my $level = delete $opts->{into_level};
149 $level = 0 unless defined $level;
150 my $caller = caller($level);
152 # we should never export to main
153 if ($caller eq 'main') {
154 warn qq{$class does not export its sugar to the 'main' package.\n};
159 for_class => $caller,
163 __PACKAGE__->export_to_level( $level+1, $class, @_);
165 # shortcut for the common case of no type character
167 for my $keyword (@EXPORT) {
168 *{ $caller . '::' . $keyword } = *{__PACKAGE__ . '::' . $keyword};
181 for my $keyword (@EXPORT) {
183 if(exists $is_removable{$keyword}
184 && ($code = $caller->can($keyword))
185 && (Mouse::Util::get_code_info($code))[0] eq __PACKAGE__){
187 delete $stash->{$keyword};
195 if (!Mouse::Util::is_valid_class_name($class)) {
196 my $display = defined($class) ? $class : 'undef';
197 confess "Invalid class name ($display)";
200 return 1 if is_class_loaded($class);
202 (my $file = "$class.pm") =~ s{::}{/}g;
204 eval { CORE::require($file) };
205 confess "Could not load class ($class) because : $@" if $@;
210 my %is_class_loaded_cache;
211 sub is_class_loaded {
214 return 0 if ref($class) || !defined($class) || !length($class);
216 return 1 if exists $is_class_loaded_cache{$class};
218 # walk the symbol table tree to avoid autovififying
219 # \*{${main::}{"Foo::"}} == \*main::Foo::
222 foreach my $part (split('::', $class)) {
223 return 0 unless exists ${$$pack}{"${part}::"};
224 $pack = \*{${$$pack}{"${part}::"}};
227 # check for $VERSION or @ISA
228 return ++$is_class_loaded_cache{$class} if exists ${$$pack}{VERSION}
229 && defined *{${$$pack}{VERSION}}{SCALAR};
230 return ++$is_class_loaded_cache{$class} if exists ${$$pack}{ISA}
231 && defined *{${$$pack}{ISA}}{ARRAY};
233 # check for any method
234 foreach ( keys %{$$pack} ) {
235 next if substr($_, -2, 2) eq '::';
236 return ++$is_class_loaded_cache{$class} if defined *{${$$pack}{$_}}{CODE};
249 Mouse - Moose minus the antlers
254 use Mouse; # automatically turns on strict and warnings
256 has 'x' => (is => 'rw', isa => 'Int');
257 has 'y' => (is => 'rw', isa => 'Int');
270 has 'z' => (is => 'rw', isa => 'Int');
272 after 'clear' => sub {
279 L<Moose> is wonderful. B<Use Moose instead of Mouse.>
281 Unfortunately, Moose has a compile-time penalty. Though significant progress
282 has been made over the years, the compile time penalty is a non-starter for
283 some very specific applications. If you are writing a command-line application
284 or CGI script where startup time is essential, you may not be able to use
285 Moose. We recommend that you instead use L<HTTP::Engine> and FastCGI for the
288 Mouse aims to alleviate this by providing a subset of Moose's functionality,
291 We're also going as light on dependencies as possible.
292 L<Class::Method::Modifiers::Fast> or L<Class::Method::Modifiers> is required
293 if you want support for L</before>, L</after>, and L</around>.
297 Compatibility with Moose has been the utmost concern. Fewer than 1% of the
298 tests fail when run against Moose instead of Mouse. Mouse code coverage is also
299 over 96%. Even the error messages are taken from Moose. The Mouse code just
300 runs the test suite 4x faster.
302 The idea is that, if you need the extra power, you should be able to run
303 C<s/Mouse/Moose/g> on your codebase and have nothing break. To that end,
304 we have written L<Any::Moose> which will act as Mouse unless Moose is loaded,
305 in which case it will act as Moose. Since Mouse is a little sloppier than
306 Moose, if you run into weird errors, it would be worth running:
308 ANY_MOOSE=Moose perl your-script.pl
310 to see if the bug is caused by Mouse. Moose's diagnostics and validation are
315 Please don't copy MooseX code to MouseX. If you need extensions, you really
316 should upgrade to Moose. We don't need two parallel sets of extensions!
318 If you really must write a Mouse extension, please contact the Moose mailing
319 list or #moose on IRC beforehand.
323 The original author of this module has mostly stepped down from maintaining
324 Mouse. See L<http://www.nntp.perl.org/group/perl.moose/2009/04/msg653.html>.
325 If you would like to help maintain this module, please get in touch with us.
329 =head2 meta -> Mouse::Meta::Class
331 Returns this class' metaclass instance.
333 =head2 extends superclasses
335 Sets this class' superclasses.
337 =head2 before (method|methods) => Code
339 Installs a "before" method modifier. See L<Moose/before> or
340 L<Class::Method::Modifiers/before>.
342 Use of this feature requires L<Class::Method::Modifiers>!
344 =head2 after (method|methods) => Code
346 Installs an "after" method modifier. See L<Moose/after> or
347 L<Class::Method::Modifiers/after>.
349 Use of this feature requires L<Class::Method::Modifiers>!
351 =head2 around (method|methods) => Code
353 Installs an "around" method modifier. See L<Moose/around> or
354 L<Class::Method::Modifiers/around>.
356 Use of this feature requires L<Class::Method::Modifiers>!
358 =head2 has (name|names) => parameters
360 Adds an attribute (or if passed an arrayref of names, multiple attributes) to
367 If specified, inlines a read-only/read-write accessor with the same name as
370 =item isa => TypeConstraint
372 Provides type checking in the constructor and accessor. The following types are
373 supported. Any unknown type is taken to be a class check (e.g. isa =>
374 'DateTime' would accept only L<DateTime> objects).
376 Any Item Bool Undef Defined Value Num Int Str ClassName
377 Ref ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef
380 For more documentation on type constraints, see L<Mouse::Util::TypeConstraints>.
383 =item required => 0|1
385 Whether this attribute is required to have a value. If the attribute is lazy or
386 has a builder, then providing a value for the attribute in the constructor is
389 =item init_arg => Str | Undef
391 Allows you to use a different key name in the constructor. If undef, the
392 attribue can't be passed to the constructor.
394 =item default => Value | CodeRef
396 Sets the default value of the attribute. If the default is a coderef, it will
397 be invoked to get the default value. Due to quirks of Perl, any bare reference
398 is forbidden, you must wrap the reference in a coderef. Otherwise, all
399 instances will share the same reference.
403 If specified, the default is calculated on demand instead of in the
406 =item predicate => Str
408 Lets you specify a method name for installing a predicate method, which checks
409 that the attribute has a value. It will not invoke a lazy default or builder
414 Lets you specify a method name for installing a clearer method, which clears
415 the attribute's value from the instance. On the next read, lazy or builder will
418 =item handles => HashRef|ArrayRef
420 Lets you specify methods to delegate to the attribute. ArrayRef forwards the
421 given method names to method calls on the attribute. HashRef maps local method
422 names to remote method names called on the attribute. Other forms of
423 L</handles>, such as regular expression and coderef, are not yet supported.
425 =item weak_ref => 0|1
427 Lets you automatically weaken any reference stored in the attribute.
429 Use of this feature requires L<Scalar::Util>!
431 =item trigger => CodeRef
433 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.
435 Mouse 0.05 supported more complex triggers, but this behavior is now removed.
439 Defines a method name to be called to provide the default value of the
440 attribute. C<< builder => 'build_foo' >> is mostly equivalent to
441 C<< default => sub { $_[0]->build_foo } >>.
443 =item auto_deref => 0|1
445 Allows you to automatically dereference ArrayRef and HashRef attributes in list
446 context. In scalar context, the reference is returned (NOT the list length or
447 bucket status). You must specify an appropriate type constraint to use
450 =item lazy_build => 0|1
452 Automatically define lazy => 1 as well as builder => "_build_$attr", clearer =>
453 "clear_$attr', predicate => 'has_$attr' unless they are already defined.
457 =head2 confess error -> BOOM
459 L<Carp/confess> for your convenience.
461 =head2 blessed value -> ClassName | undef
463 L<Scalar::Util/blessed> for your convenience.
469 Importing Mouse will default your class' superclass list to L<Mouse::Object>.
470 You may use L</extends> to replace the superclass list.
474 Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
475 keywords (such as L</extends>) it will break loudly instead breaking subtly.
479 =head2 load_class Class::Name
481 This will load a given C<Class::Name> (or die if it's not loadable).
482 This function can be used in place of tricks like
483 C<eval "use $module"> or using C<require>.
485 =head2 is_class_loaded Class::Name -> Bool
487 Returns whether this class is actually loaded or not. It uses a heuristic which
488 involves checking for the existence of C<$VERSION>, C<@ISA>, and any
489 locally-defined method.
491 =head1 SOURCE CODE ACCESS
493 We have a public git repo:
495 git clone git://jules.scsys.co.uk/gitmo/Mouse.git
499 Shawn M Moore, C<< <sartak at gmail.com> >>
501 Yuval Kogman, C<< <nothingmuch at woobling.org> >>
509 with plenty of code borrowed from L<Class::MOP> and L<Moose>
513 There is a known issue with Mouse on 5.6.2 regarding the @ISA tests. Until
514 this is resolve the minimum version of Perl for Mouse is set to 5.8.0. Patches
515 to resolve these tests are more than welcome.
517 Please report any bugs through RT: email
518 C<bug-mouse at rt.cpan.org>, or browse
519 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Mouse>.
521 =head1 COPYRIGHT AND LICENSE
523 Copyright 2008-2009 Infinity Interactive, Inc.
525 http://www.iinteractive.com/
527 This program is free software; you can redistribute it and/or modify it
528 under the same terms as Perl itself.