lib/Moo.pm

   1 package Moo;
   2
   3 use strictures 1;
   4 use Moo::_Utils;
   5 use B 'perlstring';
   6
   7 our $VERSION = '0.009010'; # 0.9.10
   8 $VERSION = eval $VERSION;
   9
  10 our %MAKERS;
  11
  12 sub import {
  13   my $target = caller;
  14   my $class = shift;
  15   strictures->import;
  16   return if $MAKERS{$target}; # already exported into this package
  17   *{_getglob("${target}::extends")} = sub {
  18     _load_module($_) for @_;
  19     # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA
  20     @{*{_getglob("${target}::ISA")}{ARRAY}} = @_;
  21   };
  22   *{_getglob("${target}::with")} = sub {
  23     { local $@; require Moo::Role; }
  24     die "Only one role supported at a time by with" if @_ > 1;
  25     Moo::Role->apply_role_to_package($target, $_[0]);
  26   };
  27   $MAKERS{$target} = {};
  28   *{_getglob("${target}::has")} = sub {
  29     my ($name, %spec) = @_;
  30     ($MAKERS{$target}{accessor} ||= do {
  31       { local $@; require Method::Generate::Accessor; }
  32       Method::Generate::Accessor->new
  33     })->generate_method($target, $name, \%spec);
  34     $class->_constructor_maker_for($target)
  35           ->register_attribute_specs($name, \%spec);
  36   };
  37   foreach my $type (qw(before after around)) {
  38     *{_getglob "${target}::${type}"} = sub {
  39       { local $@; require Class::Method::Modifiers; }
  40       _install_modifier($target, $type, @_);
  41     };
  42   }
  43   {
  44     no strict 'refs';
  45     @{"${target}::ISA"} = do {
  46       {; local $@; require Moo::Object; } ('Moo::Object');
  47     } unless @{"${target}::ISA"};
  48   }
  49 }
  50
  51 sub _constructor_maker_for {
  52   my ($class, $target, $select_super) = @_;
  53   return unless $MAKERS{$target};
  54   $MAKERS{$target}{constructor} ||= do {
  55     {
  56       local $@;
  57       require Method::Generate::Constructor;
  58       require Sub::Defer;
  59     }
  60     my ($moo_constructor, $con);
  61
  62     if ($select_super && $MAKERS{$select_super}) {
  63       $moo_constructor = 1;
  64       $con = $MAKERS{$select_super}{constructor};
  65     } else {
  66       my $t_new = $target->can('new');
  67       if ($t_new) {
  68         if ($t_new == Moo::Object->can('new')) {
  69           $moo_constructor = 1;
  70         } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) {
  71           my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
  72           if ($MAKERS{$pkg}) {
  73             $moo_constructor = 1;
  74             $con = $MAKERS{$pkg}{constructor};
  75           }
  76         }
  77       } else {
  78         $moo_constructor = 1; # no other constructor, make a Moo one
  79       }
  80     };
  81     Method::Generate::Constructor
  82       ->new(
  83         package => $target,
  84         accessor_generator => do {
  85           { local $@; require Method::Generate::Accessor; }
  86           Method::Generate::Accessor->new;
  87         },
  88         construction_string => (
  89           $moo_constructor
  90             ? ($con ? $con->construction_string : undef)
  91             : ('$class->'.$target.'::SUPER::new(@_)')
  92         ),
  93         subconstructor_generator => (
  94           $class.'->_constructor_maker_for($class,'.perlstring($target).')'
  95         ),
  96       )
  97       ->install_delayed
  98       ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}})
  99   }
 100 }
 101
 102 1;
 103 =pod
 104
 105 =encoding utf-8
 106
 107 =head1 NAME
 108
 109 Moo - Minimalist Object Orientation (with Moose compatiblity)
 110
 111 =head1 SYNOPSIS
 112
 113  package Cat::Food;
 114
 115  use Moo;
 116  use Sub::Quote;
 117
 118  sub feed_lion {
 119    my $self = shift;
 120    my $amount = shift || 1;
 121
 122    $self->pounds( $self->pounds - $amount );
 123  }
 124
 125  has taste => (
 126    is => 'ro',
 127  );
 128
 129  has brand => (
 130    is  => 'ro',
 131    isa => sub {
 132      die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ'
 133    },
 134 );
 135
 136  has pounds => (
 137    is  => 'rw',
 138    isa => quote_sub q{ die "$_[0] is too much cat food!" unless $_[0] < 15 },
 139  );
 140
 141  1;
 142
 143 and else where
 144
 145  my $full = Cat::Food->new(
 146     taste  => 'DELICIOUS.',
 147     brand  => 'SWEET-TREATZ',
 148     pounds => 10,
 149  );
 150
 151  $full->feed_lion;
 152
 153  say $full->pounds;
 154
 155 =head1 DESCRIPTION
 156
 157 This module is an extremely light-weight, high-performance L<Moose> replacement.
 158 It also avoids depending on any XS modules to allow simple deployments.  The
 159 name C<Moo> is based on the idea that it provides almost -but not quite- two
 160 thirds of L<Moose>.
 161
 162 Unlike C<Mouse> this module does not aim at full L<Moose> compatibility.  See
 163 L</INCOMPATIBILITIES> for more details.
 164
 165 =head1 WHY MOO EXISTS
 166
 167 If you want a full object system with a rich Metaprotocol, L<Moose> is
 168 already wonderful.
 169
 170 I've tried several times to use L<Mouse> but it's 3x the size of Moo and
 171 takes longer to load than most of my Moo based CGI scripts take to run.
 172
 173 If you don't want L<Moose>, you don't want "less metaprotocol" like L<Mouse>,
 174 you want "as little as possible" - which means "no metaprotocol", which is
 175 what Moo provides.
 176
 177 By Moo 1.0 I intend to have Moo's equivalent of L<Any::Moose> built in -
 178 if Moose gets loaded, any Moo class or role will act as a Moose equivalent
 179 if treated as such.
 180
 181 Hence - Moo exists as its name - Minimal Object Orientation - with a pledge
 182 to make it smooth to upgrade to L<Moose> when you need more than minimal
 183 features.
 184
 185 =head1 IMPORTED METHODS
 186
 187 =head2 new
 188
 189  Foo::Bar->new( attr1 => 3 );
 190
 191 or
 192
 193  Foo::Bar->new({ attr1 => 3 });
 194
 195 =head2 BUILDARGS
 196
 197  around BUILDARGS => sub {
 198    my $orig = shift;
 199    my ( $class, @args ) = @_;
 200
 201    unshift @args, "attr1" if @args % 2 == 1;
 202
 203    return $class->$orig(@args);
 204  };
 205
 206  Foo::Bar->new( 3 );
 207
 208 The default implementation of this method accepts a hash or hash reference of
 209 named parameters. If it receives a single argument that isn't a hash reference
 210 it throws an error.
 211
 212 You can override this method in your class to handle other types of options
 213 passed to the constructor.
 214
 215 This method should always return a hash reference of named options.
 216
 217 =head2 BUILDALL
 218
 219 Don't override (or probably even call) this method.  Instead, you can define
 220 a C<BUILD> method on your class and the constructor will automatically call the
 221 C<BUILD> method from parent down to child after the object has been
 222 instantiated.  Typically this is used for object validation or possibly logging.
 223
 224 =head2 DESTROY
 225
 226 A default destructor is provided, which calls
 227 C<< $instance->DEMOLISH($in_global_destruction) >> for each C<DEMOLISH>
 228 method in the inheritance hierarchy.
 229
 230 =head2 does
 231
 232  if ($foo->does('Some::Role1')) {
 233    ...
 234  }
 235
 236 Returns true if the object composes in the passed role.
 237
 238 =head1 IMPORTED SUBROUTINES
 239
 240 =head2 extends
 241
 242  extends 'Parent::Class';
 243
 244 Declares base class. Multiple superclasses can be passed for multiple
 245 inheritance (but please use roles instead).
 246
 247 Calling extends more than once will REPLACE your superclasses, not add to
 248 them like 'use base' would.
 249
 250 =head2 with
 251
 252  with 'Some::Role1';
 253  with 'Some::Role2';
 254
 255 Composes a L<Role::Tiny> into current class.  Only one role may be composed in
 256 at a time to allow the code to remain as simple as possible.
 257
 258 =head2 has
 259
 260  has attr => (
 261    is => 'ro',
 262  );
 263
 264 Declares an attribute for the class.
 265
 266 The options for C<has> are as follows:
 267
 268 =over 2
 269
 270 =item * is
 271
 272 B<required>, must be C<ro> or C<rw>.  Unsurprisingly, C<ro> generates an
 273 accessor that will not respond to arguments; to be clear: a getter only. C<rw>
 274 will create a perlish getter/setter.
 275
 276 =item * isa
 277
 278 Takes a coderef which is meant to validate the attribute.  Unlike L<Moose> Moo
 279 does not include a basic type system, so instead of doing C<< isa => 'Num' >>,
 280 one should do
 281
 282  isa => quote_sub q{
 283    die "$_[0] is not a number!" unless looks_like_number $_[0]
 284  },
 285
 286 L<Sub::Quote aware|/SUB QUOTE AWARE>
 287
 288 =item * coerce
 289
 290 Takes a coderef which is meant to coerce the attribute.  The basic idea is to
 291 do something like the following:
 292
 293  coerce => quote_sub q{
 294    $_[0] + 1 unless $_[0] % 2
 295  },
 296
 297 Coerce does not require C<isa> to be defined.
 298
 299 L<Sub::Quote aware|/SUB QUOTE AWARE>
 300
 301 =item * trigger
 302
 303 Takes a coderef which will get called any time the attribute is set. Coderef
 304 will be invoked against the object with the new value as an argument.
 305
 306 Note that Moose also passes the old value, if any; this feature is not yet
 307 supported.
 308
 309 L<Sub::Quote aware|/SUB QUOTE AWARE>
 310
 311 =item * default
 312
 313 Takes a coderef which will get called with $self as its only argument
 314 to populate an attribute if no value is supplied to the constructor - or
 315 if the attribute is lazy, when the attribute is first retrieved if no
 316 value has yet been provided.
 317
 318 Note that if your default is fired during new() there is no guarantee that
 319 other attributes have been populated yet so you should not rely on their
 320 existence.
 321
 322 L<Sub::Quote aware|/SUB QUOTE AWARE>
 323
 324 =item * predicate
 325
 326 Takes a method name which will return true if an attribute has a value.
 327
 328 A common example of this would be to call it C<has_$foo>, implying that the
 329 object has a C<$foo> set.
 330
 331 =item * builder
 332
 333 Takes a method name which will be called to create the attribute - functions
 334 exactly like default except that instead of calling
 335
 336   $default->($self);
 337
 338 Moo will call
 339
 340   $self->$builder;
 341
 342 =item * clearer
 343
 344 Takes a method name which will clear the attribute.
 345
 346 =item * lazy
 347
 348 B<Boolean>.  Set this if you want values for the attribute to be grabbed
 349 lazily.  This is usually a good idea if you have a L</builder> which requires
 350 another attribute to be set.
 351
 352 =item * required
 353
 354 B<Boolean>.  Set this if the attribute must be passed on instantiation.
 355
 356 =item * reader
 357
 358 The value of this attribute will be the name of the method to get the value of
 359 the attribute.  If you like Java style methods, you might set this to
 360 C<get_foo>
 361
 362 =item * writer
 363
 364 The value of this attribute will be the name of the method to set the value of
 365 the attribute.  If you like Java style methods, you might set this to
 366 C<set_foo>
 367
 368 =item * weak_ref
 369
 370 B<Boolean>.  Set this if you want the reference that the attribute contains to
 371 be weakened; use this when circular references are possible, which will cause
 372 leaks.
 373
 374 =item * init_arg
 375
 376 Takes the name of the key to look for at instantiation time of the object.  A
 377 common use of this is to make an underscored attribute have a non-underscored
 378 initialization name. C<undef> means that passing the value in on instantiation
 379
 380 =back
 381
 382 =head2 before
 383
 384  before foo => sub { ... };
 385
 386 See L<< Class::Method::Modifiers/before method(s) => sub { ... } >> for full
 387 documentation.
 388
 389 =head2 around
 390
 391  around foo => sub { ... };
 392
 393 See L<< Class::Method::Modifiers/around method(s) => sub { ... } >> for full
 394 documentation.
 395
 396 =head2 after
 397
 398  after foo => sub { ... };
 399
 400 See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full
 401 documentation.
 402
 403 =head1 SUB QUOTE AWARE
 404
 405 L<Sub::Quote/quote_sub> allows us to create coderefs that are "inlineable,"
 406 giving us a handy, XS-free speed boost.  Any option that is L<Sub::Quote>
 407 aware can take advantage of this.
 408
 409 =head1 INCOMPATIBILITIES WITH MOOSE
 410
 411 You can only compose one role at a time.  If your application is large or
 412 complex enough to warrant complex composition, you wanted L<Moose>.
 413
 414 There is no complex type system.  C<isa> is verified with a coderef, if you
 415 need complex types, just make a library of coderefs, or better yet, functions
 416 that return quoted subs.
 417
 418 C<initializer> is not supported in core since the author considers it to be a
 419 bad idea but may be supported by an extension in future.
 420
 421 There is no meta object.  If you need this level of complexity you wanted
 422 L<Moose> - Moo succeeds at being small because it explicitly does not
 423 provide a metaprotocol.
 424
 425 No support for C<super>, C<override>, C<inner>, or C<augment> - override can
 426 be handled by around albeit with a little more typing, and the author considers
 427 augment to be a bad idea.
 428
 429 L</default> only supports coderefs, because doing otherwise is usually a
 430 mistake anyway.
 431
 432 C<lazy_build> is not supported per se, but of course it will work if you
 433 manually set all the options it implies.
 434
 435 C<auto_deref> is not supported since the author considers it a bad idea.
 436
 437 C<documentation> is not supported since it's a very poor replacement for POD.
 438
 439 =head1 AUTHOR
 440
 441 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 442
 443 =head1 CONTRIBUTORS
 444
 445 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
 446
 447 frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
 448
 449 hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
 450
 451 jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
 452
 453 ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
 454
 455 chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
 456
 457 ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
 458
 459 =head1 COPYRIGHT
 460
 461 Copyright (c) 2010-2011 the Moo L</AUTHOR> and L</CONTRIBUTORS>
 462 as listed above.
 463
 464 =head1 LICENSE
 465
 466 This library is free software and may be distributed under the same terms
 467 as perl itself.
 468
 469 =cut