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