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