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