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_02';
   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_02
 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. The sugary interface is
 216 highly compatible with Moose. Even the error messages are taken from Moose.
 217 The Mouse code just runs the test suite 4x faster.
 218
 219 The idea is that, if you need the extra power, you should be able to run
 220 C<s/Mouse/Moose/g> on your codebase and have nothing break. To that end,
 221 we have written L<Any::Moose> which will act as Mouse unless Moose is loaded,
 222 in which case it will act as Moose. Since Mouse is a little sloppier than
 223 Moose, if you run into weird errors, it would be worth running:
 224
 225     ANY_MOOSE=Moose perl your-script.pl
 226
 227 to see if the bug is caused by Mouse. Moose's diagnostics and validation are
 228 also better.
 229
 230 See also L<Mouse::Spec> for compatibility and incompatibility with Moose.
 231
 232 =head2 MouseX
 233
 234 Please don't copy MooseX code to MouseX. If you need extensions, you really
 235 should upgrade to Moose. We don't need two parallel sets of extensions!
 236
 237 If you really must write a Mouse extension, please contact the Moose mailing
 238 list or #moose on IRC beforehand.
 239
 240 =head1 KEYWORDS
 241
 242 =head2 C<< $object->meta -> Mouse::Meta::Class >>
 243
 244 Returns this class' metaclass instance.
 245
 246 =head2 C<< extends superclasses >>
 247
 248 Sets this class' superclasses.
 249
 250 =head2 C<< before (method|methods|regexp) => CodeRef >>
 251
 252 Installs a "before" method modifier. See L<Moose/before>.
 253
 254 =head2 C<< after (method|methods|regexp) => CodeRef >>
 255
 256 Installs an "after" method modifier. See L<Moose/after>.
 257
 258 =head2 C<< around (method|methods|regexp) => CodeRef >>
 259
 260 Installs an "around" method modifier. See L<Moose/around>.
 261
 262 =head2 C<< has (name|names) => parameters >>
 263
 264 Adds an attribute (or if passed an arrayref of names, multiple attributes) to
 265 this class. Options:
 266
 267 =over 4
 268
 269 =item C<< is => ro|rw|bare >>
 270
 271 The I<is> option accepts either I<rw> (for read/write), I<ro> (for read
 272 only) or I<bare> (for nothing). These will create either a read/write accessor
 273 or a read-only accessor respectively, using the same name as the C<$name> of
 274 the attribute.
 275
 276 If you need more control over how your accessors are named, you can
 277 use the C<reader>, C<writer> and C<accessor> options, however if you
 278 use those, you won't need the I<is> option.
 279
 280 =item C<< isa => TypeName | ClassName >>
 281
 282 Provides type checking in the constructor and accessor. The following types are
 283 supported. Any unknown type is taken to be a class check
 284 (e.g. C<< isa => 'DateTime' >> would accept only L<DateTime> objects).
 285
 286     Any Item Bool Undef Defined Value Num Int Str ClassName
 287     Ref ScalarRef ArrayRef HashRef CodeRef RegexpRef GlobRef
 288     FileHandle Object
 289
 290 For more documentation on type constraints, see L<Mouse::Util::TypeConstraints>.
 291
 292 =item C<< does => RoleName >>
 293
 294 This will accept the name of a role which the value stored in this attribute
 295 is expected to have consumed.
 296
 297 =item C<< coerce => Bool >>
 298
 299 This will attempt to use coercion with the supplied type constraint to change
 300 the value passed into any accessors or constructors. You B<must> have supplied
 301 a type constraint in order for this to work. See L<Moose::Cookbook::Basics::Recipe5>
 302 for an example.
 303
 304 =item C<< required => Bool >>
 305
 306 Whether this attribute is required to have a value. If the attribute is lazy or
 307 has a builder, then providing a value for the attribute in the constructor is
 308 optional.
 309
 310 =item C<< init_arg => Str | Undef >>
 311
 312 Allows you to use a different key name in the constructor.  If undef, the
 313 attribute can't be passed to the constructor.
 314
 315 =item C<< default => Value | CodeRef >>
 316
 317 Sets the default value of the attribute. If the default is a coderef, it will
 318 be invoked to get the default value. Due to quirks of Perl, any bare reference
 319 is forbidden, you must wrap the reference in a coderef. Otherwise, all
 320 instances will share the same reference.
 321
 322 =item C<< lazy => Bool >>
 323
 324 If specified, the default is calculated on demand instead of in the
 325 constructor.
 326
 327 =item C<< predicate => Str >>
 328
 329 Lets you specify a method name for installing a predicate method, which checks
 330 that the attribute has a value. It will not invoke a lazy default or builder
 331 method.
 332
 333 =item C<< clearer => Str >>
 334
 335 Lets you specify a method name for installing a clearer method, which clears
 336 the attribute's value from the instance. On the next read, lazy or builder will
 337 be invoked.
 338
 339 =item C<< handles => HashRef|ArrayRef|Regexp >>
 340
 341 Lets you specify methods to delegate to the attribute. ArrayRef forwards the
 342 given method names to method calls on the attribute. HashRef maps local method
 343 names to remote method names called on the attribute. Other forms of
 344 L</handles>, such as RoleName and CodeRef, are not yet supported.
 345
 346 =item C<< weak_ref => Bool >>
 347
 348 Lets you automatically weaken any reference stored in the attribute.
 349
 350 Use of this feature requires L<Scalar::Util>!
 351
 352 =item C<< trigger => CodeRef >>
 353
 354 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.
 355
 356 =item C<< builder => Str >>
 357
 358 Defines a method name to be called to provide the default value of the
 359 attribute. C<< builder => 'build_foo' >> is mostly equivalent to
 360 C<< default => sub { $_[0]->build_foo } >>.
 361
 362 =item C<< auto_deref => Bool >>
 363
 364 Allows you to automatically dereference ArrayRef and HashRef attributes in list
 365 context. In scalar context, the reference is returned (NOT the list length or
 366 bucket status). You must specify an appropriate type constraint to use
 367 auto_deref.
 368
 369 =item C<< lazy_build => Bool >>
 370
 371 Automatically define the following options:
 372
 373     has $attr => (
 374         # ...
 375         lazy      => 1
 376         builder   => "_build_$attr",
 377         clearer   => "clear_$attr",
 378         predicate => "has_$attr",
 379     );
 380
 381 =back
 382
 383 =head2 C<< confess(message) -> BOOM >>
 384
 385 L<Carp/confess> for your convenience.
 386
 387 =head2 C<< blessed(value) -> ClassName | undef >>
 388
 389 L<Scalar::Util/blessed> for your convenience.
 390
 391 =head1 MISC
 392
 393 =head2 import
 394
 395 Importing Mouse will default your class' superclass list to L<Mouse::Object>.
 396 You may use L</extends> to replace the superclass list.
 397
 398 =head2 unimport
 399
 400 Please unimport Mouse (C<no Mouse>) so that if someone calls one of the
 401 keywords (such as L</extends>) it will break loudly instead breaking subtly.
 402
 403 =head1 CAVEATS
 404
 405 If you use Mouse::XS you might see a fatal error on callbacks
 406 which include C<eval 'BEGIN{ die }'>, which typically occurs in such code
 407 as C<eval 'use NotInstalledModule'>. This is not
 408 a bug in Mouse. In fact, it is a bug in Perl (RT #69939).
 409
 410 To work around this problem, surround C<eval STRING> with C<eval BLOCK>:
 411
 412     sub callback {
 413         # eval 'use NotInstalledModule';       # NG
 414         eval{ eval 'use NotInstalledModule' }; # OK
 415     }
 416
 417 It seems ridiculous, but it works as you expected.
 418
 419 =head1 SOURCE CODE ACCESS
 420
 421 We have a public git repository:
 422
 423  git clone git://git.moose.perl.org/Mouse.git
 424
 425 =head1 DEPENDENCIES
 426
 427 Perl 5.6.2 or later.
 428
 429 =head1 SEE ALSO
 430
 431 L<Mouse::Spec>
 432
 433 L<Moose>
 434
 435 L<Moose::Manual>
 436
 437 L<Moose::Cookbook>
 438
 439 L<Class::MOP>
 440
 441 =head1 AUTHORS
 442
 443 Shawn M Moore E<lt>sartak at gmail.comE<gt>
 444
 445 Yuval Kogman E<lt>nothingmuch at woobling.orgE<gt>
 446
 447 tokuhirom
 448
 449 Yappo
 450
 451 wu-lee
 452
 453 Goro Fuji (gfx) E<lt>gfuji at cpan.orgE<gt>
 454
 455 with plenty of code borrowed from L<Class::MOP> and L<Moose>
 456
 457 =head1 BUGS
 458
 459 All complex software has bugs lurking in it, and this module is no exception.
 460 Please report any bugs to C<bug-mouse at rt.cpan.org>, or through the web
 461 interface at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Mouse>
 462
 463 =head1 COPYRIGHT AND LICENSE
 464
 465 Copyright (c) 2008-2010 Infinity Interactive, Inc.
 466
 467 http://www.iinteractive.com/
 468
 469 This program is free software; you can redistribute it and/or modify it
 470 under the same terms as Perl itself.
 471
 472 =cut
 473