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