lib/Moo.pm

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