lib/Mouse.pm

   1 package Mouse;
   2 use 5.006_002;
   3
   4 use Mouse::Exporter; # enables strict and warnings
   5
   6 our $VERSION = '0.40_08';
   7
   8 use Carp         qw(confess);
   9 use Scalar::Util qw(blessed);
  10
  11 use Mouse::Util qw(load_class is_class_loaded get_code_package not_supported);
  12
  13 use Mouse::Meta::Module;
  14 use Mouse::Meta::Class;
  15 use Mouse::Meta::Role;
  16 use Mouse::Meta::Attribute;
  17 use Mouse::Object;
  18 use Mouse::Util::TypeConstraints ();
  19
  20 Mouse::Exporter->setup_import_methods(
  21     as_is => [qw(
  22         extends with
  23         has
  24         before after around
  25         override super
  26         augment  inner
  27     ),
  28         \&Scalar::Util::blessed,
  29         \&Carp::confess,
  30    ],
  31 );
  32
  33
  34 sub extends {
  35     Mouse::Meta::Class->initialize(scalar caller)->superclasses(@_);
  36     return;
  37 }
  38
  39 sub with {
  40     Mouse::Util::apply_all_roles(scalar(caller), @_);
  41     return;
  42 }
  43
  44 sub has {
  45     my $meta = Mouse::Meta::Class->initialize(scalar caller);
  46     my $name = shift;
  47
  48     $meta->throw_error(q{Usage: has 'name' => ( key => value, ... )})
  49         if @_ % 2; # odd number of arguments
  50
  51     if(ref $name){ # has [qw(foo bar)] => (...)
  52         for (@{$name}){
  53             $meta->add_attribute($_ => @_);
  54         }
  55     }
  56     else{ # has foo => (...)
  57         $meta->add_attribute($name => @_);
  58     }
  59     return;
  60 }
  61
  62 sub before {
  63     my $meta = Mouse::Meta::Class->initialize(scalar caller);
  64
  65     my $code = pop;
  66
  67     for (@_) {
  68         $meta->add_before_method_modifier($_ => $code);
  69     }
  70     return;
  71 }
  72
  73 sub after {
  74     my $meta = Mouse::Meta::Class->initialize(scalar caller);
  75
  76     my $code = pop;
  77
  78     for (@_) {
  79         $meta->add_after_method_modifier($_ => $code);
  80     }
  81     return;
  82 }
  83
  84 sub around {
  85     my $meta = Mouse::Meta::Class->initialize(scalar caller);
  86
  87     my $code = pop;
  88
  89     for (@_) {
  90         $meta->add_around_method_modifier($_ => $code);
  91     }
  92     return;
  93 }
  94
  95 our $SUPER_PACKAGE;
  96 our $SUPER_BODY;
  97 our @SUPER_ARGS;
  98
  99 sub super {
 100     # This check avoids a recursion loop - see
 101     # t/100_bugs/020_super_recursion.t
 102     return if  defined $SUPER_PACKAGE && $SUPER_PACKAGE ne caller();
 103     return if !defined $SUPER_BODY;
 104     $SUPER_BODY->(@SUPER_ARGS);
 105 }
 106
 107 sub override {
 108     # my($name, $method) = @_;
 109     Mouse::Meta::Class->initialize(scalar caller)->add_override_method_modifier(@_);
 110 }
 111
 112 our %INNER_BODY;
 113 our %INNER_ARGS;
 114
 115 sub inner {
 116     my $pkg = caller();
 117     if ( my $body = $INNER_BODY{$pkg} ) {
 118         my $args = $INNER_ARGS{$pkg};
 119         local $INNER_ARGS{$pkg};
 120         local $INNER_BODY{$pkg};
 121         return $body->(@{$args});
 122     }
 123     else {
 124         return;
 125     }
 126 }
 127
 128 sub augment {
 129     #my($name, $method) = @_;
 130     Mouse::Meta::Class->initialize(scalar caller)->add_augment_method_modifier(@_);
 131     return;
 132 }
 133
 134 sub init_meta {
 135     shift;
 136     my %args = @_;
 137
 138     my $class = $args{for_class}
 139                     or confess("Cannot call init_meta without specifying a for_class");
 140
 141     my $base_class = $args{base_class} || 'Mouse::Object';
 142     my $metaclass  = $args{metaclass}  || 'Mouse::Meta::Class';
 143
 144     my $meta = $metaclass->initialize($class);
 145
 146     $meta->add_method(meta => sub{
 147         return $metaclass->initialize(ref($_[0]) || $_[0]);
 148     });
 149
 150     $meta->superclasses($base_class)
 151         unless $meta->superclasses;
 152
 153     # make a class type for each Mouse class
 154     Mouse::Util::TypeConstraints::class_type($class)
 155         unless Mouse::Util::TypeConstraints::find_type_constraint($class);
 156
 157     return $meta;
 158 }
 159
 160
 161 1;
 162 __END__
 163
 164 =head1 NAME
 165
 166 Mouse - Moose minus the antlers
 167
 168 =head1 VERSION
 169
 170 This document describes Mouse version 0.40_08
 171
 172 =head1 SYNOPSIS
 173
 174     package Point;
 175     use Mouse; # automatically turns on strict and warnings
 176
 177     has 'x' => (is => 'rw', isa => 'Int');
 178     has 'y' => (is => 'rw', isa => 'Int');
 179
 180     sub clear {
 181         my $self = shift;
 182         $self->x(0);
 183         $self->y(0);
 184     }
 185
 186     package Point3D;
 187     use Mouse;
 188
 189     extends 'Point';
 190
 191     has 'z' => (is => 'rw', isa => 'Int');
 192
 193     after 'clear' => sub {
 194         my $self = shift;
 195         $self->z(0);
 196     };
 197
 198 =head1 DESCRIPTION
 199
 200 L<Moose> is wonderful. B<Use Moose instead of Mouse.>
 201
 202 Unfortunately, Moose has a compile-time penalty. Though significant progress
 203 has been made over the years, the compile time penalty is a non-starter for
 204 some very specific applications. If you are writing a command-line application
 205 or CGI script where startup time is essential, you may not be able to use
 206 Moose. We recommend that you instead use L<HTTP::Engine> and FastCGI for the
 207 latter, if possible.
 208
 209 Mouse aims to alleviate this by providing a subset of Moose's functionality,
 210 faster.
 211
 212 We're also going as light on dependencies as possible. Mouse currently has
 213 B<no dependencies> except for testing modules.
 214
 215 =head2 MOOSE COMPATIBILITY
 216
 217 Compatibility with Moose has been the utmost concern. Fewer than 1% of the
 218 tests fail when run against Moose instead of Mouse. Mouse code coverage is also
 219 over 96%. Even the error messages are taken from Moose. The Mouse code just
 220 runs the test suite 4x faster.
 221
 222 The idea is that, if you need the extra power, you should be able to run
 223 C<s/Mouse/Moose/g> on your codebase and have nothing break. To that end,
 224 we have written L<Any::Moose> which will act as Mouse unless Moose is loaded,
 225 in which case it will act as Moose. Since Mouse is a little sloppier than
 226 Moose, if you run into weird errors, it would be worth running:
 227
 228     ANY_MOOSE=Moose perl your-script.pl
 229
 230 to see if the bug is caused by Mouse. Moose's diagnostics and validation are
 231 also much better.
 232
 233 See also L<Mouse::Spec> for compatibility and incompatibility with Moose.
 234
 235 =head2 MouseX
 236
 237 Please don't copy MooseX code to MouseX. If you need extensions, you really
 238 should upgrade to Moose. We don't need two parallel sets of extensions!
 239
 240 If you really must write a Mouse extension, please contact the Moose mailing
 241 list or #moose on IRC beforehand.
 242
 243 =head1 KEYWORDS
 244
 245 =head2 C<< $object->meta -> Mouse::Meta::Class >>
 246
 247 Returns this class' metaclass instance.
 248
 249 =head2 C<< extends superclasses >>
 250
 251 Sets this class' superclasses.
 252
 253 =head2 C<< before (method|methods) => CodeRef >>
 254
 255 Installs a "before" method modifier. See L<Moose/before> or
 256 L<Class::Method::Modifiers/before>.
 257
 258 Use of this feature requires L<Class::Method::Modifiers>!
 259
 260 =head2 C<< after (method|methods) => CodeRef >>
 261
 262 Installs an "after" method modifier. See L<Moose/after> or
 263 L<Class::Method::Modifiers/after>.
 264
 265 Use of this feature requires L<Class::Method::Modifiers>!
 266
 267 =head2 C<< around (method|methods) => CodeRef >>
 268
 269 Installs an "around" method modifier. See L<Moose/around> or
 270 L<Class::Method::Modifiers/around>.
 271
 272 Use of this feature requires L<Class::Method::Modifiers>!
 273
 274 =head2 C<< has (name|names) => parameters >>
 275
 276 Adds an attribute (or if passed an arrayref of names, multiple attributes) to
 277 this class. Options:
 278
 279 =over 4
 280
 281 =item C<< is => ro|rw|bare >>
 282
 283 If specified, inlines a read-only/read-write accessor with the same name as
 284 the attribute.
 285
 286 =item C<< isa => TypeConstraint >>
 287
 288 Provides type checking in the constructor and accessor. The following types are
 289 supported. Any unknown type is taken to be a class check
 290 (e.g. C<< isa => 'DateTime' >> would accept only L<DateTime> objects).
 291
 292     Any Item Bool Undef Defined Value Num Int Str ClassName
 293     Ref ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef
 294     FileHandle Object
 295
 296 For more documentation on type constraints, see L<Mouse::Util::TypeConstraints>.
 297
 298
 299 =item C<< required => Bool >>
 300
 301 Whether this attribute is required to have a value. If the attribute is lazy or
 302 has a builder, then providing a value for the attribute in the constructor is
 303 optional.
 304
 305 =item C<< init_arg => Str | Undef >>
 306
 307 Allows you to use a different key name in the constructor.  If undef, the
 308 attribute can't be passed to the constructor.
 309
 310 =item C<< default => Value | CodeRef >>
 311
 312 Sets the default value of the attribute. If the default is a coderef, it will
 313 be invoked to get the default value. Due to quirks of Perl, any bare reference
 314 is forbidden, you must wrap the reference in a coderef. Otherwise, all
 315 instances will share the same reference.
 316
 317 =item C<< lazy => Bool >>
 318
 319 If specified, the default is calculated on demand instead of in the
 320 constructor.
 321
 322 =item C<< predicate => Str >>
 323
 324 Lets you specify a method name for installing a predicate method, which checks
 325 that the attribute has a value. It will not invoke a lazy default or builder
 326 method.
 327
 328 =item C<< clearer => Str >>
 329
 330 Lets you specify a method name for installing a clearer method, which clears
 331 the attribute's value from the instance. On the next read, lazy or builder will
 332 be invoked.
 333
 334 =item C<< handles => HashRef|ArrayRef >>
 335
 336 Lets you specify methods to delegate to the attribute. ArrayRef forwards the
 337 given method names to method calls on the attribute. HashRef maps local method
 338 names to remote method names called on the attribute. Other forms of
 339 L</handles>, such as regular expression and coderef, are not yet supported.
 340
 341 =item C<< weak_ref => Bool >>
 342
 343 Lets you automatically weaken any reference stored in the attribute.
 344
 345 Use of this feature requires L<Scalar::Util>!
 346
 347 =item C<< trigger => CodeRef >>
 348
 349 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.
 350
 351 =item C<< builder => Str >>
 352
 353 Defines a method name to be called to provide the default value of the
 354 attribute. C<< builder => 'build_foo' >> is mostly equivalent to
 355 C<< default => sub { $_[0]->build_foo } >>.
 356
 357 =item C<< auto_deref => Bool >>
 358
 359 Allows you to automatically dereference ArrayRef and HashRef attributes in list
 360 context. In scalar context, the reference is returned (NOT the list length or
 361 bucket status). You must specify an appropriate type constraint to use
 362 auto_deref.
 363
 364 =item C<< lazy_build => Bool >>
 365
 366 Automatically define the following options:
 367
 368     has $attr => (
 369         # ...
 370         lazy      => 1
 371         builder   => "_build_$attr",
 372         clearer   => "clear_$attr",
 373         predicate => "has_$attr",
 374     );
 375
 376 =back
 377
 378 =head2 C<< confess(message) -> BOOM >>
 379
 380 L<Carp/confess> for your convenience.
 381
 382 =head2 C<< blessed(value) -> ClassName | undef >>
 383
 384 L<Scalar::Util/blessed> for your convenience.
 385
 386 =head1 MISC
 387
 388 =head2 import
 389
 390 Importing Mouse will default your class' superclass list to L<Mouse::Object>.
 391 You may use L</extends> to replace the superclass list.
 392
 393 =head2 unimport
 394
 395 Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
 396 keywords (such as L</extends>) it will break loudly instead breaking subtly.
 397
 398 =head1 SOURCE CODE ACCESS
 399
 400 We have a public git repository:
 401
 402  git clone git://git.moose.perl.org/Mouse.git
 403
 404 =head1 DEPENDENCIES
 405
 406 Perl 5.6.2 or later.
 407
 408 =head1 SEE ALSO
 409
 410 L<Mouse::Spec>
 411
 412 L<Moose>
 413
 414 L<Class::MOP>
 415
 416 =head1 AUTHORS
 417
 418 Shawn M Moore E<lt>sartak at gmail.comE<gt>
 419
 420 Yuval Kogman E<lt>nothingmuch at woobling.orgE<gt>
 421
 422 tokuhirom
 423
 424 Yappo
 425
 426 wu-lee
 427
 428 Goro Fuji (gfx) E<lt>gfuji at cpan.orgE<gt>
 429
 430 with plenty of code borrowed from L<Class::MOP> and L<Moose>
 431
 432 =head1 BUGS
 433
 434 All complex software has bugs lurking in it, and this module is no exception.
 435 Please report any bugs to C<bug-mouse at rt.cpan.org>, or through the web
 436 interface at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Mouse>
 437
 438 =head1 COPYRIGHT AND LICENSE
 439
 440 Copyright 2008-2009 Infinity Interactive, Inc.
 441
 442 http://www.iinteractive.com/
 443
 444 This program is free software; you can redistribute it and/or modify it
 445 under the same terms as Perl itself.
 446
 447 =cut
 448