d7eee7739073969239e6d99fbbd296594bfcfbfe
[gitmo/Moo.git] / lib / Moo.pm
1 package Moo;
2
3 use strictures 1;
4 use Moo::_Utils;
5 use B 'perlstring';
6 use Sub::Defer ();
7
8 our $VERSION = '0.091014'; # 0.91.14
9 $VERSION = eval $VERSION;
10
11 require Moo::sification;
12
13 our %MAKERS;
14
15 sub _install_tracked {
16   my ($target, $name, $code) = @_;
17   $MAKERS{$target}{exports}{$name} = $code;
18   _install_coderef "${target}::${name}" => "Moo::${name}" => $code;
19 }
20
21 sub import {
22   my $target = caller;
23   my $class = shift;
24   strictures->import;
25   return if $MAKERS{$target}; # already exported into this package
26   $MAKERS{$target} = {};
27   _install_tracked $target => extends => sub {
28     $class->_set_superclasses($target, @_);
29     $class->_maybe_reset_handlemoose($target);
30     return;
31   };
32   _install_tracked $target => with => sub {
33     require Moo::Role;
34     Moo::Role->apply_roles_to_package($target, @_);
35     $class->_maybe_reset_handlemoose($target);
36   };
37   _install_tracked $target => has => sub {
38     my ($name, %spec) = @_;
39     $class->_constructor_maker_for($target)
40           ->register_attribute_specs($name, \%spec);
41     $class->_accessor_maker_for($target)
42           ->generate_method($target, $name, \%spec);
43     $class->_maybe_reset_handlemoose($target);
44     return;
45   };
46   foreach my $type (qw(before after around)) {
47     _install_tracked $target => $type => sub {
48       require Class::Method::Modifiers;
49       _install_modifier($target, $type, @_);
50       return;
51     };
52   }
53   {
54     no strict 'refs';
55     @{"${target}::ISA"} = do {
56       require Moo::Object; ('Moo::Object');
57     } unless @{"${target}::ISA"};
58   }
59   if ($INC{'Moo/HandleMoose.pm'}) {
60     Moo::HandleMoose::inject_fake_metaclass_for($target);
61   }
62 }
63
64 sub unimport {
65   my $target = caller;
66   _unimport_coderefs($target, $MAKERS{$target});
67 }
68
69 sub _set_superclasses {
70   my $class = shift;
71   my $target = shift;
72   for (@_) {
73     _load_module($_);
74     if ($INC{"Role/Tiny.pm"} && $Role::Tiny::INFO{$_}) {
75       require Carp;
76       Carp::croak("Can't extend role '$_'");
77     }
78   }
79   # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA
80   @{*{_getglob("${target}::ISA")}{ARRAY}} = @_;
81   if (my $old = delete $Moo::MAKERS{$target}{constructor}) {
82     delete _getstash($target)->{new};
83     Moo->_constructor_maker_for($target)
84        ->register_attribute_specs(%{$old->all_attribute_specs});
85   }
86   no warnings 'once'; # piss off. -- mst
87   $Moo::HandleMoose::MOUSE{$target} = [
88     grep defined, map Mouse::Util::find_meta($_), @_
89   ] if $INC{"Mouse.pm"};
90 }
91
92 sub _maybe_reset_handlemoose {
93   my ($class, $target) = @_;
94   if ($INC{"Moo/HandleMoose.pm"}) {
95     Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target);
96   }
97 }
98
99 sub _accessor_maker_for {
100   my ($class, $target) = @_;
101   return unless $MAKERS{$target};
102   $MAKERS{$target}{accessor} ||= do {
103     my $maker_class = do {
104       if (my $m = do {
105             if (my $defer_target = 
106                   (Sub::Defer::defer_info($target->can('new'))||[])->[0]
107               ) {
108               my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
109               $MAKERS{$pkg} && $MAKERS{$pkg}{accessor};
110             } else {
111               undef;
112             }
113           }) {
114         ref($m);
115       } else {
116         require Method::Generate::Accessor;
117         'Method::Generate::Accessor'
118       }
119     };
120     $maker_class->new;
121   }
122 }
123
124 sub _constructor_maker_for {
125   my ($class, $target, $select_super) = @_;
126   return unless $MAKERS{$target};
127   $MAKERS{$target}{constructor} ||= do {
128     require Method::Generate::Constructor;
129     require Sub::Defer;
130     my ($moo_constructor, $con);
131
132     if ($select_super && $MAKERS{$select_super}) {
133       $moo_constructor = 1;
134       $con = $MAKERS{$select_super}{constructor};
135     } else {
136       my $t_new = $target->can('new');
137       if ($t_new) {
138         if ($t_new == Moo::Object->can('new')) {
139           $moo_constructor = 1;
140         } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) {
141           my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/);
142           if ($MAKERS{$pkg}) {
143             $moo_constructor = 1;
144             $con = $MAKERS{$pkg}{constructor};
145           }
146         }
147       } else {
148         $moo_constructor = 1; # no other constructor, make a Moo one
149       }
150     };
151     ($con ? ref($con) : 'Method::Generate::Constructor')
152       ->new(
153         package => $target,
154         accessor_generator => $class->_accessor_maker_for($target),
155         construction_string => (
156           $moo_constructor
157             ? ($con ? $con->construction_string : undef)
158             : ('$class->'.$target.'::SUPER::new(@_)')
159         ),
160         subconstructor_handler => (
161           '      if ($Moo::MAKERS{$class}) {'."\n"
162           .'        '.$class.'->_constructor_maker_for($class,'.perlstring($target).');'."\n"
163           .'        return $class->new(@_)'.";\n"
164           .'      } elsif ($INC{"Moose.pm"} and my $meta = Class::MOP::get_metaclass_by_name($class)) {'."\n"
165           .'        return $meta->new_object(@_);'."\n"
166           .'      }'."\n"
167         ),
168       )
169       ->install_delayed
170       ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}})
171   }
172 }
173
174 1;
175 =pod
176
177 =encoding utf-8
178
179 =head1 NAME
180
181 Moo - Minimalist Object Orientation (with Moose compatiblity)
182
183 =head1 SYNOPSIS
184
185  package Cat::Food;
186
187  use Moo;
188  use Sub::Quote;
189
190  sub feed_lion {
191    my $self = shift;
192    my $amount = shift || 1;
193
194    $self->pounds( $self->pounds - $amount );
195  }
196
197  has taste => (
198    is => 'ro',
199  );
200
201  has brand => (
202    is  => 'ro',
203    isa => sub {
204      die "Only SWEET-TREATZ supported!" unless $_[0] eq 'SWEET-TREATZ'
205    },
206 );
207
208  has pounds => (
209    is  => 'rw',
210    isa => quote_sub q{ die "$_[0] is too much cat food!" unless $_[0] < 15 },
211  );
212
213  1;
214
215 and else where
216
217  my $full = Cat::Food->new(
218     taste  => 'DELICIOUS.',
219     brand  => 'SWEET-TREATZ',
220     pounds => 10,
221  );
222
223  $full->feed_lion;
224
225  say $full->pounds;
226
227 =head1 DESCRIPTION
228
229 This module is an extremely light-weight, high-performance L<Moose> replacement.
230 It also avoids depending on any XS modules to allow simple deployments.  The
231 name C<Moo> is based on the idea that it provides almost -but not quite- two
232 thirds of L<Moose>.
233
234 Unlike C<Mouse> this module does not aim at full L<Moose> compatibility.  See
235 L</INCOMPATIBILITIES> for more details.
236
237 =head1 WHY MOO EXISTS
238
239 If you want a full object system with a rich Metaprotocol, L<Moose> is
240 already wonderful.
241
242 I've tried several times to use L<Mouse> but it's 3x the size of Moo and
243 takes longer to load than most of my Moo based CGI scripts take to run.
244
245 If you don't want L<Moose>, you don't want "less metaprotocol" like L<Mouse>,
246 you want "as little as possible" - which means "no metaprotocol", which is
247 what Moo provides.
248
249 By Moo 1.0 I intend to have Moo's equivalent of L<Any::Moose> built in -
250 if Moose gets loaded, any Moo class or role will act as a Moose equivalent
251 if treated as such.
252
253 Hence - Moo exists as its name - Minimal Object Orientation - with a pledge
254 to make it smooth to upgrade to L<Moose> when you need more than minimal
255 features.
256
257 =head1 Moo and Moose - NEW, EXPERIMENTAL
258
259 If L<Moo> detects L<Moose> being loaded, it will automatically register
260 metaclasses for your L<Moo> and L<Moo::Role> packages, so you should be able
261 to use them in L<Moose> code without it ever realising you aren't using
262 L<Moose> everywhere.
263
264 Extending a L<Moose> class or consuming a L<Moose::Role> should also work.
265
266 So should extending a L<Mouse> class or consuming a L<Mouse::Role>.
267
268 This means that there is no need for anything like L<Any::Moose> for Moo
269 code - Moo and Moose code should simply interoperate without problem. To
270 handle L<Mouse> code, you'll likely need an empty Moo role or class consuming
271 or extending the L<Mouse> stuff since it doesn't register true L<Moose>
272 metaclasses like we do.
273
274 However, these features are new as of 0.91.0 (0.091000) so while serviceable,
275 they are absolutely certain to not be 100% yet; please do report bugs.
276
277 If you need to disable the metaclass creation, add:
278
279   no Moo::sification;
280
281 to your code before Moose is loaded, but bear in mind that this switch is
282 currently global and turns the mechanism off entirely, so don't put this
283 in library code, only in a top level script as a temporary measure while
284 you send a bug report.
285
286 =head1 IMPORTED METHODS
287
288 =head2 new
289
290  Foo::Bar->new( attr1 => 3 );
291
292 or
293
294  Foo::Bar->new({ attr1 => 3 });
295
296 =head2 BUILDARGS
297
298  sub BUILDARGS {
299    my ( $class, @args ) = @_;
300
301    unshift @args, "attr1" if @args % 2 == 1;
302
303    return { @args };
304  };
305
306  Foo::Bar->new( 3 );
307
308 The default implementation of this method accepts a hash or hash reference of
309 named parameters. If it receives a single argument that isn't a hash reference
310 it throws an error.
311
312 You can override this method in your class to handle other types of options
313 passed to the constructor.
314
315 This method should always return a hash reference of named options.
316
317 =head2 BUILD
318
319 Define a C<BUILD> method on your class and the constructor will automatically
320 call the C<BUILD> method from parent down to child after the object has
321 been instantiated.  Typically this is used for object validation or possibly
322 logging.
323
324 =head2 DEMOLISH
325
326 If you have a C<DEMOLISH> method anywhere in your inheritance hierarchy,
327 a C<DESTROY> method is created on first object construction which will call
328 C<< $instance->DEMOLISH($in_global_destruction) >> for each C<DEMOLISH>
329 method from child upwards to parents.
330
331 Note that the C<DESTROY> method is created on first construction of an object
332 of your class in order to not add overhead to classes without C<DEMOLISH>
333 methods; this may prove slightly surprising if you try and define your own.
334
335 =head2 does
336
337  if ($foo->does('Some::Role1')) {
338    ...
339  }
340
341 Returns true if the object composes in the passed role.
342
343 =head1 IMPORTED SUBROUTINES
344
345 =head2 extends
346
347  extends 'Parent::Class';
348
349 Declares base class. Multiple superclasses can be passed for multiple
350 inheritance (but please use roles instead).
351
352 Calling extends more than once will REPLACE your superclasses, not add to
353 them like 'use base' would.
354
355 =head2 with
356
357  with 'Some::Role1';
358
359 or
360
361  with 'Some::Role1', 'Some::Role2';
362
363 Composes one or more L<Moo::Role> (or L<Role::Tiny>) roles into the current
364 class.  An error will be raised if these roles have conflicting methods.
365
366 =head2 has
367
368  has attr => (
369    is => 'ro',
370  );
371
372 Declares an attribute for the class.
373
374 The options for C<has> are as follows:
375
376 =over 2
377
378 =item * is
379
380 B<required>, may be C<ro>, C<lazy>, C<rwp> or C<rw>.
381
382 C<ro> generates an accessor that dies if you attempt to write to it - i.e.
383 a getter only - by defaulting C<reader> to the name of the attribute.
384
385 C<lazy> generates a reader like C<ro>, but also sets C<lazy> to 1 and
386 C<builder> to C<_build_${attribute_name}> to allow on-demand generated
387 attributes.  This feature was my attempt to fix my incompetence when
388 originally designing C<lazy_build>, and is also implemented by
389 L<MooseX::AttributeShortcuts>.
390
391 C<rwp> generates a reader like C<ro>, but also sets C<writer> to
392 C<_set_${attribute_name}> for attributes that are designed to be written
393 from inside of the class, but read-only from outside.
394 This feature comes from L<MooseX::AttributeShortcuts>.
395
396 C<rw> generates a normal getter/setter by defaulting C<accessor> to the
397 name of the attribute.
398
399 =item * isa
400
401 Takes a coderef which is meant to validate the attribute.  Unlike L<Moose> Moo
402 does not include a basic type system, so instead of doing C<< isa => 'Num' >>,
403 one should do
404
405  isa => quote_sub q{
406    die "$_[0] is not a number!" unless looks_like_number $_[0]
407  },
408
409 L<Sub::Quote aware|/SUB QUOTE AWARE>
410
411 Since L<Moo> does B<not> run the C<isa> check before C<coerce> if a coercion
412 subroutine has been supplied, C<isa> checks are not structural to your code
413 and can, if desired, be omitted on non-debug builds (although if this results
414 in an uncaught bug causing your program to break, the L<Moo> authors guarantee
415 nothing except that you get to keep both halves).
416
417 If you want L<MooseX::Types> style named types, look at
418 L<MooX::Types::MooseLike>.
419
420 To cause your C<isa> entries to be automatically mapped to named
421 L<Moose::Meta::TypeConstraint> objects (rather than the default behaviour
422 of creating an anonymous type), set:
423
424   $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub {
425     require MooseX::Types::Something;
426     return MooseX::Types::Something::TypeName();
427   };
428
429 Note that this example is purely illustrative; anything that returns a
430 L<Moose::Meta::TypeConstraint> object or something similar enough to it to
431 make L<Moose> happy is fine.
432
433 =item * coerce
434
435 Takes a coderef which is meant to coerce the attribute.  The basic idea is to
436 do something like the following:
437
438  coerce => quote_sub q{
439    $_[0] + 1 unless $_[0] % 2
440  },
441
442 Note that L<Moo> will always fire your coercion - this is to permit
443 isa entries to be used purely for bug trapping, whereas coercions are
444 always structural to your code. We do, however, apply any supplied C<isa>
445 check after the coercion has run to ensure that it returned a valid value.
446
447 L<Sub::Quote aware|/SUB QUOTE AWARE>
448
449 =item * handles
450
451 Takes a string
452
453   handles => 'RobotRole'
454
455 Where C<RobotRole> is a role (L<Moo::Role>) that defines an interface which
456 becomes the list of methods to handle.
457
458 Takes a list of methods
459
460  handles => [ qw( one two ) ]
461
462 Takes a hashref
463
464  handles => {
465    un => 'one',
466  }
467
468 =item * trigger
469
470 Takes a coderef which will get called any time the attribute is set. This
471 includes the constructor. Coderef will be invoked against the object with the
472 new value as an argument.
473
474 If you set this to just C<1>, it generates a trigger which calls the
475 C<_trigger_${attr_name}> method on C<$self>. This feature comes from
476 L<MooseX::AttributeShortcuts>.
477
478 Note that Moose also passes the old value, if any; this feature is not yet
479 supported.
480
481 L<Sub::Quote aware|/SUB QUOTE AWARE>
482
483 =item * default
484
485 Takes a coderef which will get called with $self as its only argument
486 to populate an attribute if no value is supplied to the constructor - or
487 if the attribute is lazy, when the attribute is first retrieved if no
488 value has yet been provided.
489
490 Note that if your default is fired during new() there is no guarantee that
491 other attributes have been populated yet so you should not rely on their
492 existence.
493
494 L<Sub::Quote aware|/SUB QUOTE AWARE>
495
496 =item * predicate
497
498 Takes a method name which will return true if an attribute has a value.
499
500 If you set this to just C<1>, the predicate is automatically named
501 C<has_${attr_name}> if your attribute's name does not start with an
502 underscore, or <_has_${attr_name_without_the_underscore}> if it does.
503 This feature comes from L<MooseX::AttributeShortcuts>.
504
505 =item * builder
506
507 Takes a method name which will be called to create the attribute - functions
508 exactly like default except that instead of calling
509
510   $default->($self);
511
512 Moo will call
513
514   $self->$builder;
515
516 If you set this to just C<1>, the predicate is automatically named
517 C<_build_${attr_name}>.  This feature comes from L<MooseX::AttributeShortcuts>.
518
519 =item * clearer
520
521 Takes a method name which will clear the attribute.
522
523 If you set this to just C<1>, the clearer is automatically named
524 C<clear_${attr_name}> if your attribute's name does not start with an
525 underscore, or <_clear_${attr_name_without_the_underscore}> if it does.
526 This feature comes from L<MooseX::AttributeShortcuts>.
527
528 =item * lazy
529
530 B<Boolean>.  Set this if you want values for the attribute to be grabbed
531 lazily.  This is usually a good idea if you have a L</builder> which requires
532 another attribute to be set.
533
534 =item * required
535
536 B<Boolean>.  Set this if the attribute must be passed on instantiation.
537
538 =item * reader
539
540 The value of this attribute will be the name of the method to get the value of
541 the attribute.  If you like Java style methods, you might set this to
542 C<get_foo>
543
544 =item * writer
545
546 The value of this attribute will be the name of the method to set the value of
547 the attribute.  If you like Java style methods, you might set this to
548 C<set_foo>
549
550 =item * weak_ref
551
552 B<Boolean>.  Set this if you want the reference that the attribute contains to
553 be weakened; use this when circular references are possible, which will cause
554 leaks.
555
556 =item * init_arg
557
558 Takes the name of the key to look for at instantiation time of the object.  A
559 common use of this is to make an underscored attribute have a non-underscored
560 initialization name. C<undef> means that passing the value in on instantiation
561 is ignored.
562
563 =back
564
565 =head2 before
566
567  before foo => sub { ... };
568
569 See L<< Class::Method::Modifiers/before method(s) => sub { ... } >> for full
570 documentation.
571
572 =head2 around
573
574  around foo => sub { ... };
575
576 See L<< Class::Method::Modifiers/around method(s) => sub { ... } >> for full
577 documentation.
578
579 =head2 after
580
581  after foo => sub { ... };
582
583 See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full
584 documentation.
585
586 =head1 SUB QUOTE AWARE
587
588 L<Sub::Quote/quote_sub> allows us to create coderefs that are "inlineable,"
589 giving us a handy, XS-free speed boost.  Any option that is L<Sub::Quote>
590 aware can take advantage of this.
591
592 =head1 INCOMPATIBILITIES WITH MOOSE
593
594 There is no built in type system.  C<isa> is verified with a coderef, if you
595 need complex types, just make a library of coderefs, or better yet, functions
596 that return quoted subs. L<MooX::Types::MooseLike> provides a similar API
597 to L<MooseX::Types::Moose> so that you can write
598
599   has days_to_live => (is => 'ro', isa => Int);
600
601 and have it work with both; it is hoped that providing only subrefs as an
602 API will encourage the use of other type systems as well, since it's
603 probably the weakest part of Moose design-wise.
604
605 C<initializer> is not supported in core since the author considers it to be a
606 bad idea but may be supported by an extension in future. Meanwhile C<trigger> or
607 C<coerce> are more likely to be able to fulfill your needs.
608
609 There is no meta object.  If you need this level of complexity you wanted
610 L<Moose> - Moo succeeds at being small because it explicitly does not
611 provide a metaprotocol. However, if you load L<Moose>, then
612
613   Class::MOP::class_of($moo_class_or_role)
614
615 will return an appropriate metaclass pre-populated by L<Moo>.
616
617 No support for C<super>, C<override>, C<inner>, or C<augment> - the author
618 considers augment to be a bad idea, and override can be translated:
619
620   override foo => sub {
621     ...
622     super();
623     ...
624   };
625
626   around foo => sub {
627     my ($orig, $self) = (shift, shift);
628     ...
629     $self->$orig(@_);
630     ...
631   };
632
633 The C<dump> method is not provided by default. The author suggests loading
634 L<Devel::Dwarn> into C<main::> (via C<perl -MDevel::Dwarn ...> for example) and
635 using C<$obj-E<gt>$::Dwarn()> instead.
636
637 L</default> only supports coderefs, because doing otherwise is usually a
638 mistake anyway.
639
640 C<lazy_build> is not supported; you are instead encouraged to use the
641 C<is => 'lazy'> option supported by L<Moo> and L<MooseX::AttributeShortcuts>.
642
643 C<auto_deref> is not supported since the author considers it a bad idea.
644
645 C<documentation> will show up in a L<Moose> metaclass created from your class
646 but is otherwise ignored. Then again, L<Moose> ignores it as well, so this
647 is arguably not an incompatibility.
648
649 Since C<coerce> does not require C<isa> to be defined but L<Moose> does
650 require it, the metaclass inflation for coerce-alone is a trifle insane
651 and if you attempt to subtype the result will almost certainly break.
652
653 Handling of warnings: when you C<use Moo> we enable FATAL warnings.  The nearest
654 similar invocation for L<Moose> would be:
655
656   use Moose;
657   use warnings FATAL => "all";
658
659 Additionally, L<Moo> supports a set of attribute option shortcuts intended to
660 reduce common boilerplate.  The set of shortcuts is the same as in the L<Moose>
661 module L<MooseX::AttributeShortcuts> as of its version 0.009+.  So if you:
662
663     package MyClass;
664     use Moo;
665
666 The nearest L<Moose> invocation would be:
667
668     package MyClass;
669
670     use Moose;
671     use warnings FATAL => "all";
672     use MooseX::AttributeShortcuts;
673
674 or, if you're inheriting from a non-Moose class,
675
676     package MyClass;
677
678     use Moose;
679     use MooseX::NonMoose;
680     use warnings FATAL => "all";
681     use MooseX::AttributeShortcuts;
682
683 Finally, Moose requires you to call
684
685     __PACKAGE__->meta->make_immutable;
686
687 at the end of your class to get an inlined (i.e. not horribly slow)
688 constructor. Moo does it automatically the first time ->new is called
689 on your class.
690
691 =head1 SUPPORT
692
693 Users' IRC: #moose on irc.perl.org
694
695 Development and contribution IRC: #web-simple on irc.perl.org
696
697 =head1 AUTHOR
698
699 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
700
701 =head1 CONTRIBUTORS
702
703 dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
704
705 frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
706
707 hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
708
709 jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
710
711 ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
712
713 chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
714
715 ajgb - Alex J. G. BurzyƄski (cpan:AJGB) <ajgb@cpan.org>
716
717 doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
718
719 perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
720
721 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
722
723 =head1 COPYRIGHT
724
725 Copyright (c) 2010-2011 the Moo L</AUTHOR> and L</CONTRIBUTORS>
726 as listed above.
727
728 =head1 LICENSE
729
730 This library is free software and may be distributed under the same terms
731 as perl itself.
732
733 =cut