lib/Moo.pm

   1 package Moo;
   2
   3 use strictures 1;
   4 use Moo::_Utils;
   5 use B 'perlstring';
   6
   7 our $VERSION = '0.009012'; # 0.9.12
   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 BUILD
 218
 219 Define a C<BUILD> method on your class and the constructor will automatically
 220 call the C<BUILD> method from parent down to child after the object has
 221 been instantiated.  Typically this is used for object validation or possibly
 222 logging.
 223
 224 =head2 DEMOLISH
 225
 226 If you have a C<DEMOLISH> method anywhere in your inheritance hierarchy,
 227 a C<DESTROY> method is created on first object construction which will call
 228 C<< $instance->DEMOLISH($in_global_destruction) >> for each C<DEMOLISH>
 229 method from child upwards to parents.
 230
 231 Note that the C<DESTROY> method is created on first construction of an object
 232 of your class in order to not add overhead to classes without C<DEMOLISH>
 233 methods; this may prove slightly surprising if you try and define your own.
 234
 235 =head2 does
 236
 237  if ($foo->does('Some::Role1')) {
 238    ...
 239  }
 240
 241 Returns true if the object composes in the passed role.
 242
 243 =head1 IMPORTED SUBROUTINES
 244
 245 =head2 extends
 246
 247  extends 'Parent::Class';
 248
 249 Declares base class. Multiple superclasses can be passed for multiple
 250 inheritance (but please use roles instead).
 251
 252 Calling extends more than once will REPLACE your superclasses, not add to
 253 them like 'use base' would.
 254
 255 =head2 with
 256
 257  with 'Some::Role1';
 258  with 'Some::Role2';
 259
 260 Composes a L<Role::Tiny> into current class.  Only one role may be composed in
 261 at a time to allow the code to remain as simple as possible.
 262
 263 =head2 has
 264
 265  has attr => (
 266    is => 'ro',
 267  );
 268
 269 Declares an attribute for the class.
 270
 271 The options for C<has> are as follows:
 272
 273 =over 2
 274
 275 =item * is
 276
 277 B<required>, must be C<ro> or C<rw>.  Unsurprisingly, C<ro> generates an
 278 accessor that will not respond to arguments; to be clear: a getter only. C<rw>
 279 will create a perlish getter/setter.
 280
 281 =item * isa
 282
 283 Takes a coderef which is meant to validate the attribute.  Unlike L<Moose> Moo
 284 does not include a basic type system, so instead of doing C<< isa => 'Num' >>,
 285 one should do
 286
 287  isa => quote_sub q{
 288    die "$_[0] is not a number!" unless looks_like_number $_[0]
 289  },
 290
 291 L<Sub::Quote aware|/SUB QUOTE AWARE>
 292
 293 =item * coerce
 294
 295 Takes a coderef which is meant to coerce the attribute.  The basic idea is to
 296 do something like the following:
 297
 298  coerce => quote_sub q{
 299    $_[0] + 1 unless $_[0] % 2
 300  },
 301
 302 Coerce does not require C<isa> to be defined.
 303
 304 L<Sub::Quote aware|/SUB QUOTE AWARE>
 305
 306 =item * handles
 307
 308 Takes a string
 309
 310   handles => 'RobotRole'
 311
 312 Where C<RobotRole> is a role (L<Moo::Role>) that defines an interface which
 313 becomes the list of methods to handle.
 314
 315 Takes a list of methods
 316
 317  handles => [ qw( one two ) ]
 318
 319 Takes a hashref
 320
 321  handles => {
 322    un => 'one',
 323  }
 324
 325 =item * trigger
 326
 327 Takes a coderef which will get called any time the attribute is set. Coderef
 328 will be invoked against the object with the new value as an argument.
 329
 330 Note that Moose also passes the old value, if any; this feature is not yet
 331 supported.
 332
 333 L<Sub::Quote aware|/SUB QUOTE AWARE>
 334
 335 =item * default
 336
 337 Takes a coderef which will get called with $self as its only argument
 338 to populate an attribute if no value is supplied to the constructor - or
 339 if the attribute is lazy, when the attribute is first retrieved if no
 340 value has yet been provided.
 341
 342 Note that if your default is fired during new() there is no guarantee that
 343 other attributes have been populated yet so you should not rely on their
 344 existence.
 345
 346 L<Sub::Quote aware|/SUB QUOTE AWARE>
 347
 348 =item * predicate
 349
 350 Takes a method name which will return true if an attribute has a value.
 351
 352 A common example of this would be to call it C<has_$foo>, implying that the
 353 object has a C<$foo> set.
 354
 355 =item * builder
 356
 357 Takes a method name which will be called to create the attribute - functions
 358 exactly like default except that instead of calling
 359
 360   $default->($self);
 361
 362 Moo will call
 363
 364   $self->$builder;
 365
 366 =item * clearer
 367
 368 Takes a method name which will clear the attribute.
 369
 370 =item * lazy
 371
 372 B<Boolean>.  Set this if you want values for the attribute to be grabbed
 373 lazily.  This is usually a good idea if you have a L</builder> which requires
 374 another attribute to be set.
 375
 376 =item * required
 377
 378 B<Boolean>.  Set this if the attribute must be passed on instantiation.
 379
 380 =item * reader
 381
 382 The value of this attribute will be the name of the method to get the value of
 383 the attribute.  If you like Java style methods, you might set this to
 384 C<get_foo>
 385
 386 =item * writer
 387
 388 The value of this attribute will be the name of the method to set the value of
 389 the attribute.  If you like Java style methods, you might set this to
 390 C<set_foo>
 391
 392 =item * weak_ref
 393
 394 B<Boolean>.  Set this if you want the reference that the attribute contains to
 395 be weakened; use this when circular references are possible, which will cause
 396 leaks.
 397
 398 =item * init_arg
 399
 400 Takes the name of the key to look for at instantiation time of the object.  A
 401 common use of this is to make an underscored attribute have a non-underscored
 402 initialization name. C<undef> means that passing the value in on instantiation
 403
 404 =back
 405
 406 =head2 before
 407
 408  before foo => sub { ... };
 409
 410 See L<< Class::Method::Modifiers/before method(s) => sub { ... } >> for full
 411 documentation.
 412
 413 =head2 around
 414
 415  around foo => sub { ... };
 416
 417 See L<< Class::Method::Modifiers/around method(s) => sub { ... } >> for full
 418 documentation.
 419
 420 =head2 after
 421
 422  after foo => sub { ... };
 423
 424 See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full
 425 documentation.
 426
 427 =head1 SUB QUOTE AWARE
 428
 429 L<Sub::Quote/quote_sub> allows us to create coderefs that are "inlineable,"
 430 giving us a handy, XS-free speed boost.  Any option that is L<Sub::Quote>
 431 aware can take advantage of this.
 432
 433 =head1 INCOMPATIBILITIES WITH MOOSE
 434
 435 You can only compose one role at a time.  If your application is large or
 436 complex enough to warrant complex composition, you wanted L<Moose>.
 437
 438 There is no complex type system.  C<isa> is verified with a coderef, if you
 439 need complex types, just make a library of coderefs, or better yet, functions
 440 that return quoted subs.
 441
 442 C<initializer> is not supported in core since the author considers it to be a
 443 bad idea but may be supported by an extension in future.
 444
 445 There is no meta object.  If you need this level of complexity you wanted
 446 L<Moose> - Moo succeeds at being small because it explicitly does not
 447 provide a metaprotocol.
 448
 449 No support for C<super>, C<override>, C<inner>, or C<augment> - override can
 450 be handled by around albeit with a little more typing, and the author considers
 451 augment to be a bad idea.
 452
 453 L</default> only supports coderefs, because doing otherwise is usually a
 454 mistake anyway.
 455
 456 C<lazy_build> is not supported per se, but of course it will work if you
 457 manually set all the options it implies.
 458
 459 C<auto_deref> is not supported since the author considers it a bad idea.
 460
 461 C<documentation> is not supported since it's a very poor replacement for POD.
 462
 463 Handling of warnings: when you C<use Moo> we enable FATAL warnings.  The nearest
 464 similar invocation for L<Moose> would be:
 465
 466   use Moose;
 467   use warnings FATAL => "all";
 468
 469 Additionally, L<Moo> supports a set of attribute option shortcuts intended to
 470 reduce common boilerplate.  The set of shortcuts is the same as in the L<Moose>
 471 module L<MooseX::AttributeShortcuts>.  So if you:
 472
 473     package MyClass;
 474     use Moo;
 475
 476 The nearest L<Moose> invocation would be:
 477
 478     package MyClass;
 479
 480     use Moose;
 481     use warnings FATAL => "all";
 482     use MooseX::AttributeShortcuts;
 483
 484 =head1 AUTHOR
 485
 486 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 487
 488 =head1 CONTRIBUTORS
 489
 490 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
 491
 492 frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
 493
 494 hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
 495
 496 jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
 497
 498 ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
 499
 500 chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
 501
 502 ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
 503
 504 doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
 505
 506 =head1 COPYRIGHT
 507
 508 Copyright (c) 2010-2011 the Moo L</AUTHOR> and L</CONTRIBUTORS>
 509 as listed above.
 510
 511 =head1 LICENSE
 512
 513 This library is free software and may be distributed under the same terms
 514 as perl itself.
 515
 516 =cut