lib/Mouse.pm

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