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