X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoo.pm;h=fdd46e214ab91c0cabb495fc84b39ec471279faf;hb=141b507ace5957c098c52ceb7afaf21d5928a02d;hp=efe18f0792b6f31b5cf82a09b9001803df3eba36;hpb=505f8b7ac27f299ab035f3f0f40a022f5b88d391;p=gitmo%2FMoo.git diff --git a/lib/Moo.pm b/lib/Moo.pm index efe18f0..fdd46e2 100644 --- a/lib/Moo.pm +++ b/lib/Moo.pm @@ -2,40 +2,58 @@ package Moo; use strictures 1; use Moo::_Utils; +use B 'perlstring'; +use Sub::Defer (); -our $VERSION = '0.009001'; # 0.9.1 +our $VERSION = '1.000005'; # 1.0.5 $VERSION = eval $VERSION; +require Moo::sification; + our %MAKERS; +sub _install_tracked { + my ($target, $name, $code) = @_; + $MAKERS{$target}{exports}{$name} = $code; + _install_coderef "${target}::${name}" => "Moo::${name}" => $code; +} + sub import { my $target = caller; my $class = shift; strictures->import; return if $MAKERS{$target}; # already exported into this package - *{_getglob("${target}::extends")} = sub { - _load_module($_) for @_; - *{_getglob("${target}::ISA")} = \@_; + $MAKERS{$target} = {}; + _install_tracked $target => extends => sub { + $class->_set_superclasses($target, @_); + $class->_maybe_reset_handlemoose($target); + return; }; - *{_getglob("${target}::with")} = sub { + _install_tracked $target => with => sub { require Moo::Role; - die "Only one role supported at a time by with" if @_ > 1; - Moo::Role->apply_role_to_package($_[0], $target); + Moo::Role->apply_roles_to_package($target, @_); + $class->_maybe_reset_handlemoose($target); }; - $MAKERS{$target} = {}; - *{_getglob("${target}::has")} = sub { - my ($name, %spec) = @_; - ($MAKERS{$target}{accessor} ||= do { - require Method::Generate::Accessor; - Method::Generate::Accessor->new - })->generate_method($target, $name, \%spec); - $class->_constructor_maker_for($target) - ->register_attribute_specs($name, \%spec); + _install_tracked $target => has => sub { + my ($name_proto, %spec) = @_; + my $name_isref = ref $name_proto eq 'ARRAY'; + foreach my $name ($name_isref ? @$name_proto : $name_proto) { + # Note that when $name_proto is an arrayref, each attribute + # needs a separate \%specs hashref + my $spec_ref = $name_isref ? +{%spec} : \%spec; + $class->_constructor_maker_for($target) + ->register_attribute_specs($name, $spec_ref); + $class->_accessor_maker_for($target) + ->generate_method($target, $name, $spec_ref); + $class->_maybe_reset_handlemoose($target); + } + return; }; foreach my $type (qw(before after around)) { - *{_getglob "${target}::${type}"} = sub { + _install_tracked $target => $type => sub { require Class::Method::Modifiers; _install_modifier($target, $type, @_); + return; }; } { @@ -44,41 +62,126 @@ sub import { require Moo::Object; ('Moo::Object'); } unless @{"${target}::ISA"}; } + if ($INC{'Moo/HandleMoose.pm'}) { + Moo::HandleMoose::inject_fake_metaclass_for($target); + } } -sub _constructor_maker_for { +sub unimport { + my $target = caller; + _unimport_coderefs($target, $MAKERS{$target}); +} + +sub _set_superclasses { + my $class = shift; + my $target = shift; + foreach my $superclass (@_) { + _load_module($superclass); + if ($INC{"Role/Tiny.pm"} && $Role::Tiny::INFO{$superclass}) { + require Carp; + Carp::croak("Can't extend role '$superclass'"); + } + } + # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA + @{*{_getglob("${target}::ISA")}{ARRAY}} = @_; + if (my $old = delete $Moo::MAKERS{$target}{constructor}) { + delete _getstash($target)->{new}; + Moo->_constructor_maker_for($target) + ->register_attribute_specs(%{$old->all_attribute_specs}); + } + no warnings 'once'; # piss off. -- mst + $Moo::HandleMoose::MOUSE{$target} = [ + grep defined, map Mouse::Util::find_meta($_), @_ + ] if $INC{"Mouse.pm"}; +} + +sub _maybe_reset_handlemoose { + my ($class, $target) = @_; + if ($INC{"Moo/HandleMoose.pm"}) { + Moo::HandleMoose::maybe_reinject_fake_metaclass_for($target); + } +} + +sub _accessor_maker_for { my ($class, $target) = @_; return unless $MAKERS{$target}; + $MAKERS{$target}{accessor} ||= do { + my $maker_class = do { + if (my $m = do { + if (my $defer_target = + (Sub::Defer::defer_info($target->can('new'))||[])->[0] + ) { + my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/); + $MAKERS{$pkg} && $MAKERS{$pkg}{accessor}; + } else { + undef; + } + }) { + ref($m); + } else { + require Method::Generate::Accessor; + 'Method::Generate::Accessor' + } + }; + $maker_class->new; + } +} + +sub _constructor_maker_for { + my ($class, $target, $select_super) = @_; + return unless $MAKERS{$target}; $MAKERS{$target}{constructor} ||= do { require Method::Generate::Constructor; - Method::Generate::Constructor + require Sub::Defer; + my ($moo_constructor, $con); + + if ($select_super && $MAKERS{$select_super}) { + $moo_constructor = 1; + $con = $MAKERS{$select_super}{constructor}; + } else { + my $t_new = $target->can('new'); + if ($t_new) { + if ($t_new == Moo::Object->can('new')) { + $moo_constructor = 1; + } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) { + my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/); + if ($MAKERS{$pkg}) { + $moo_constructor = 1; + $con = $MAKERS{$pkg}{constructor}; + } + } + } else { + $moo_constructor = 1; # no other constructor, make a Moo one + } + }; + ($con ? ref($con) : 'Method::Generate::Constructor') ->new( package => $target, - accessor_generator => do { - require Method::Generate::Accessor; - Method::Generate::Accessor->new; - } + accessor_generator => $class->_accessor_maker_for($target), + construction_string => ( + $moo_constructor + ? ($con ? $con->construction_string : undef) + : ('$class->'.$target.'::SUPER::new(@_)') + ), + subconstructor_handler => ( + ' if ($Moo::MAKERS{$class}) {'."\n" + .' '.$class.'->_constructor_maker_for($class,'.perlstring($target).');'."\n" + .' return $class->new(@_)'.";\n" + .' } elsif ($INC{"Moose.pm"} and my $meta = Class::MOP::get_metaclass_by_name($class)) {'."\n" + .' return $meta->new_object($class->BUILDARGS(@_));'."\n" + .' }'."\n" + ), ) ->install_delayed - ->register_attribute_specs(do { - my @spec; - # using the -last- entry in @ISA means that classes created by - # Role::Tiny as N roles + superclass will still get the attributes - # from the superclass - if (my $super = do { no strict 'refs'; ${"${target}::ISA"}[-1] }) { - if (my $con = $MAKERS{$super}{constructor}) { - @spec = %{$con->all_attribute_specs}; - } - } - @spec; - }); + ->register_attribute_specs(%{$con?$con->all_attribute_specs:{}}) } } 1; - =pod +=encoding utf-8 + =head1 NAME Moo - Minimalist Object Orientation (with Moose compatiblity) @@ -88,7 +191,6 @@ Moo - Minimalist Object Orientation (with Moose compatiblity) package Cat::Food; use Moo; - use Sub::Quote; sub feed_lion { my $self = shift; @@ -110,12 +212,12 @@ Moo - Minimalist Object Orientation (with Moose compatiblity) has pounds => ( is => 'rw', - isa => quote_sub q{ die "$_[0] is too much cat food!" unless $_[0] < 15 }, + isa => sub { die "$_[0] is too much cat food!" unless $_[0] < 15 }, ); 1; -and else where +And elsewhere: my $full = Cat::Food->new( taste => 'DELICIOUS.', @@ -129,13 +231,97 @@ and else where =head1 DESCRIPTION -This module is an extremely light-weight, high-performance L replacement. +This module is an extremely light-weight subset of L optimised for +rapid startup and "pay only for what you use". + It also avoids depending on any XS modules to allow simple deployments. The -name C is based on the idea that it provides almost -but not quite- two +name C is based on the idea that it provides almost -- but not quite -- two thirds of L. -Unlike C this module does not aim at full L compatibility. See -L for more details. +Unlike L this module does not aim at full compatibility with +L's surface syntax, preferring instead of provide full interoperability +via the metaclass inflation capabilities described in L. + +For a full list of the minor differences between L and L's surface +syntax, see L. + +=head1 WHY MOO EXISTS + +If you want a full object system with a rich Metaprotocol, L is +already wonderful. + +However, sometimes you're writing a command line script or a CGI script +where fast startup is essential, or code designed to be deployed as a single +file via L, or you're writing a CPAN module and you want it +to be usable by people with those constraints. + +I've tried several times to use L but it's 3x the size of Moo and +takes longer to load than most of my Moo based CGI scripts take to run. + +If you don't want L, you don't want "less metaprotocol" like L, +you want "as little as possible" -- which means "no metaprotocol", which is +what Moo provides. + +Better still, if you install and load L, we set up metaclasses for your +L classes and L roles, so you can use them in L code +without ever noticing that some of your codebase is using L. + +Hence, Moo exists as its name -- Minimal Object Orientation -- with a pledge +to make it smooth to upgrade to L when you need more than minimal +features. + +=head1 MOO AND MOOSE + +If L detects L being loaded, it will automatically register +metaclasses for your L and L packages, so you should be able +to use them in L code without anybody ever noticing you aren't using +L everywhere. + +Extending a L class or consuming a L will also work. + +So will extending a L class or consuming a L - but note +that we don't provide L metaclasses or metaroles so the other way +around doesn't work. This feature exists for L users porting to +L; enabling L users to use L classes is not a priority for us. + +This means that there is no need for anything like L for Moo +code - Moo and Moose code should simply interoperate without problem. To +handle L code, you'll likely need an empty Moo role or class consuming +or extending the L stuff since it doesn't register true L +metaclasses like L does. + +If you want types to be upgraded to the L types, use +L and install the L library to +match the L library you're using - L will +load the L library and use that type for the newly created +metaclass. + +If you need to disable the metaclass creation, add: + + no Moo::sification; + +to your code before Moose is loaded, but bear in mind that this switch is +currently global and turns the mechanism off entirely so don't put this +in library code. + +=head1 MOO VERSUS ANY::MOOSE + +L will load L normally, and L in a program using +L - which theoretically allows you to get the startup time of L +without disadvantaging L users. + +Sadly, this doesn't entirely work, since the selection is load order dependent +- L's metaclass inflation system explained above in L is +significantly more reliable. + +So if you want to write a CPAN module that loads fast or has only pure perl +dependencies but is also fully usable by L users, you should be using +L. + +For a full explanation, see the article +L which explains +the differing strategies in more detail and provides a direct example of +where L succeeds and L fails. =head1 IMPORTED METHODS @@ -147,12 +333,44 @@ or Foo::Bar->new({ attr1 => 3 }); -=head2 BUILDALL +=head2 BUILDARGS + + sub BUILDARGS { + my ( $class, @args ) = @_; + + unshift @args, "attr1" if @args % 2 == 1; + + return { @args }; + }; + + Foo::Bar->new( 3 ); + +The default implementation of this method accepts a hash or hash reference of +named parameters. If it receives a single argument that isn't a hash reference +it throws an error. -Don't override (or probably even call) this method. Instead, you can define -a C method on your class and the constructor will automatically call the -C method from parent down to child after the object has been -instantiated. Typically this is used for object validation or possibly logging. +You can override this method in your class to handle other types of options +passed to the constructor. + +This method should always return a hash reference of named options. + +=head2 BUILD + +Define a C method on your class and the constructor will automatically +call the C method from parent down to child after the object has +been instantiated. Typically this is used for object validation or possibly +logging. + +=head2 DEMOLISH + +If you have a C method anywhere in your inheritance hierarchy, +a C method is created on first object construction which will call +C<< $instance->DEMOLISH($in_global_destruction) >> for each C +method from child upwards to parents. + +Note that the C method is created on first construction of an object +of your class in order to not add overhead to classes without C +methods; this may prove slightly surprising if you try and define your own. =head2 does @@ -168,15 +386,22 @@ Returns true if the object composes in the passed role. extends 'Parent::Class'; -Declares base class +Declares base class. Multiple superclasses can be passed for multiple +inheritance (but please use roles instead). + +Calling extends more than once will REPLACE your superclasses, not add to +them like 'use base' would. =head2 with with 'Some::Role1'; - with 'Some::Role2'; -Composes a L into current class. Only one role may be composed in -at a time to allow the code to remain as simple as possible. +or + + with 'Some::Role1', 'Some::Role2'; + +Composes one or more L (or L) roles into the current +class. An error will be raised if these roles have conflicting methods. =head2 has @@ -192,82 +417,188 @@ The options for C are as follows: =item * is -B, must be C or C. Unsurprisingly, C generates an -accessor that will not respond to arguments; to be clear: a setter only. C -will create a perlish getter/setter. +B, may be C, C, C or C. + +C generates an accessor that dies if you attempt to write to it - i.e. +a getter only - by defaulting C to the name of the attribute. + +C generates a reader like C, but also sets C to 1 and +C to C<_build_${attribute_name}> to allow on-demand generated +attributes. This feature was my attempt to fix my incompetence when +originally designing C, and is also implemented by +L. + +C generates a reader like C, but also sets C to +C<_set_${attribute_name}> for attributes that are designed to be written +from inside of the class, but read-only from outside. +This feature comes from L. + +C generates a normal getter/setter by defaulting C to the +name of the attribute. =item * isa -Takes a coderef which is meant to validate the attribute. Unlike L Moo +Takes a coderef which is meant to validate the attribute. Unlike L, Moo does not include a basic type system, so instead of doing C<< isa => 'Num' >>, one should do - isa => quote_sub q{ + isa => sub { die "$_[0] is not a number!" unless looks_like_number $_[0] }, L +Since L does B run the C check before C if a coercion +subroutine has been supplied, C checks are not structural to your code +and can, if desired, be omitted on non-debug builds (although if this results +in an uncaught bug causing your program to break, the L authors guarantee +nothing except that you get to keep both halves). + +If you want L style named types, look at +L. + +To cause your C entries to be automatically mapped to named +L objects (rather than the default behaviour +of creating an anonymous type), set: + + $Moo::HandleMoose::TYPE_MAP{$isa_coderef} = sub { + require MooseX::Types::Something; + return MooseX::Types::Something::TypeName(); + }; + +Note that this example is purely illustrative; anything that returns a +L object or something similar enough to it to +make L happy is fine. + =item * coerce Takes a coderef which is meant to coerce the attribute. The basic idea is to do something like the following: - coerce => quote_sub q{ + coerce => sub { $_[0] + 1 unless $_[0] % 2 }, +Note that L will always fire your coercion: this is to permit +C entries to be used purely for bug trapping, whereas coercions are +always structural to your code. We do, however, apply any supplied C +check after the coercion has run to ensure that it returned a valid value. + L +=item * handles + +Takes a string + + handles => 'RobotRole' + +Where C is a role (L) that defines an interface which +becomes the list of methods to handle. + +Takes a list of methods + + handles => [ qw( one two ) ] + +Takes a hashref + + handles => { + un => 'one', + } + =item * trigger -Takes a coderef which will get called any time the attribute is set. Coderef -will be invoked against the object with the new value as an argument. +Takes a coderef which will get called any time the attribute is set. This +includes the constructor. Coderef will be invoked against the object with the +new value as an argument. + +If you set this to just C<1>, it generates a trigger which calls the +C<_trigger_${attr_name}> method on C<$self>. This feature comes from +L. + +Note that Moose also passes the old value, if any; this feature is not yet +supported. L -=item * default +=item * C + +Takes a coderef which will get called with $self as its only argument +to populate an attribute if no value is supplied to the constructor - or +if the attribute is lazy, when the attribute is first retrieved if no +value has yet been provided. -Takes a coderef which will get called to populate an attribute. +Note that if your default is fired during new() there is no guarantee that +other attributes have been populated yet so you should not rely on their +existence. L -=item * predicate +=item * C + +Takes a method name which will return true if an attribute has a value. + +If you set this to just C<1>, the predicate is automatically named +C if your attribute's name does not start with an +underscore, or <_has_${attr_name_without_the_underscore}> if it does. +This feature comes from L. -Takes a method name which will return true if an attribute has been set. +=item * C -A common example of this would be to call it C, implying that the -object has a C<$foo> set. +Takes a method name which will be called to create the attribute - functions +exactly like default except that instead of calling -=item * builder + $default->($self); -Takes a method name which will be called to create the attribute. +Moo will call -=item * clearer + $self->$builder; + +If you set this to just C<1>, the predicate is automatically named +C<_build_${attr_name}>. This feature comes from L. + +=item * C Takes a method name which will clear the attribute. -=item * lazy +If you set this to just C<1>, the clearer is automatically named +C if your attribute's name does not start with an +underscore, or <_clear_${attr_name_without_the_underscore}> if it does. +This feature comes from L. + +=item * C B. Set this if you want values for the attribute to be grabbed lazily. This is usually a good idea if you have a L which requires another attribute to be set. -=item * required +=item * C B. Set this if the attribute must be passed on instantiation. -=item * weak_ref +=item * C + +The value of this attribute will be the name of the method to get the value of +the attribute. If you like Java style methods, you might set this to +C + +=item * C + +The value of this attribute will be the name of the method to set the value of +the attribute. If you like Java style methods, you might set this to +C. + +=item * C B. Set this if you want the reference that the attribute contains to be weakened; use this when circular references are possible, which will cause leaks. -=item * init_arg +=item * C Takes the name of the key to look for at instantiation time of the object. A common use of this is to make an underscored attribute have a non-underscored initialization name. C means that passing the value in on instantiation +is ignored. =back @@ -292,35 +623,189 @@ documentation. See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full documentation. - =head1 SUB QUOTE AWARE L allows us to create coderefs that are "inlineable," giving us a handy, XS-free speed boost. Any option that is L aware can take advantage of this. -=head1 INCOMPATIBILITIES +To do this, you can write + + use Moo; + use Sub::Quote; + + has foo => ( + is => 'ro', + isa => quote_sub(q{ die "Not <3" unless $_[0] < 3 }) + ); + +which will be inlined as + + do { + local @_ = ($_[0]->{foo}); + die "Not <3" unless $_[0] < 3; + } + +or to avoid localizing @_, + + has foo => ( + is => 'ro', + isa => quote_sub(q{ my ($val) = @_; die "Not <3" unless $val < 3 }) + ); -You can only compose one role at a time. If your application is large or -complex enough to warrant complex composition, you wanted L. +which will be inlined as -There is no complex type system. C is verified with a coderef, if you + do { + my ($val) = ($_[0]->{foo}); + die "Not <3" unless $val < 3; + } + +See L for more information, including how to pass lexical +captures that will also be compiled into the subroutine. + +=head1 INCOMPATIBILITIES WITH MOOSE + +There is no built-in type system. C is verified with a coderef; if you need complex types, just make a library of coderefs, or better yet, functions -that return quoted subs. +that return quoted subs. L provides a similar API +to L so that you can write + + has days_to_live => (is => 'ro', isa => Int); -C is not supported in core, but with an extension it is supported. +and have it work with both; it is hoped that providing only subrefs as an +API will encourage the use of other type systems as well, since it's +probably the weakest part of Moose design-wise. + +C is not supported in core since the author considers it to be a +bad idea but may be supported by an extension in future. Meanwhile C or +C are more likely to be able to fulfill your needs. There is no meta object. If you need this level of complexity you wanted -L. +L - Moo succeeds at being small because it explicitly does not +provide a metaprotocol. However, if you load L, then + + Class::MOP::class_of($moo_class_or_role) + +will return an appropriate metaclass pre-populated by L. + +No support for C, C, C, or C - the author +considers augment to be a bad idea, and override can be translated: + + override foo => sub { + ... + super(); + ... + }; + + around foo => sub { + my ($orig, $self) = (shift, shift); + ... + $self->$orig(@_); + ... + }; -No support for C, C, C, or C. +The C method is not provided by default. The author suggests loading +L into C (via C for example) and +using C<$obj-E$::Dwarn()> instead. L only supports coderefs, because doing otherwise is usually a mistake anyway. -C is not supported per se, but of course it will work if you -manually set all the options it implies. +C is not supported; you are instead encouraged to use the +C<< is => 'lazy' >> option supported by L and L. + +C is not supported since the author considers it a bad idea. + +C will show up in a L metaclass created from your class +but is otherwise ignored. Then again, L ignores it as well, so this +is arguably not an incompatibility. + +Since C does not require C to be defined but L does +require it, the metaclass inflation for coerce alone is a trifle insane +and if you attempt to subtype the result will almost certainly break. + +Handling of warnings: when you C we enable FATAL warnings. The nearest +similar invocation for L would be: + + use Moose; + use warnings FATAL => "all"; + +Additionally, L supports a set of attribute option shortcuts intended to +reduce common boilerplate. The set of shortcuts is the same as in the L +module L as of its version 0.009+. So if you: + + package MyClass; + use Moo; + +The nearest L invocation would be: + + package MyClass; + + use Moose; + use warnings FATAL => "all"; + use MooseX::AttributeShortcuts; + +or, if you're inheriting from a non-Moose class, + + package MyClass; + + use Moose; + use MooseX::NonMoose; + use warnings FATAL => "all"; + use MooseX::AttributeShortcuts; + +Finally, Moose requires you to call + + __PACKAGE__->meta->make_immutable; + +at the end of your class to get an inlined (i.e. not horribly slow) +constructor. Moo does it automatically the first time ->new is called +on your class. + +=head1 SUPPORT + +Users' IRC: #moose on irc.perl.org + +Development and contribution IRC: #web-simple on irc.perl.org + +=head1 AUTHOR + +mst - Matt S. Trout (cpan:MSTROUT) + +=head1 CONTRIBUTORS + +dg - David Leadbeater (cpan:DGL) + +frew - Arthur Axel "fREW" Schmidt (cpan:FREW) + +hobbs - Andrew Rodland (cpan:ARODLAND) + +jnap - John Napiorkowski (cpan:JJNAPIORK) + +ribasushi - Peter Rabbitson (cpan:RIBASUSHI) + +chip - Chip Salzenberg (cpan:CHIPS) + +ajgb - Alex J. G. Burzyński (cpan:AJGB) + +doy - Jesse Luehrs (cpan:DOY) + +perigrin - Chris Prather (cpan:PERIGRIN) + +Mithaldu - Christian Walde (cpan:MITHALDU) + +ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) + +tobyink - Toby Inkster (cpan:TOBYINK) + +=head1 COPYRIGHT + +Copyright (c) 2010-2011 the Moo L and L +as listed above. + +=head1 LICENSE -C is not supported. +This library is free software and may be distributed under the same terms +as perl itself. -C is not supported. +=cut