X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoo.pm;h=1dd93ef1a29e1997b56955757cd81162665e4500;hb=627063f747490fee83eb70650d7d0403e62ba68b;hp=01150cedae22b1b2cb65c95577acc674fc652ba6;hpb=3d41242a1597252093a6aa2e9ad13ea9cf30a101;p=gitmo%2FMoo.git diff --git a/lib/Moo.pm b/lib/Moo.pm index 01150ce..1dd93ef 100644 --- a/lib/Moo.pm +++ b/lib/Moo.pm @@ -3,20 +3,28 @@ package Moo; use strictures 1; use Moo::_Utils; use B 'perlstring'; +use Sub::Defer (); -our $VERSION = '0.091000'; # 0.91.0 +our $VERSION = '0.091009'; # 0.91.9 $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 - _install_coderef "${target}::extends" => sub { + $MAKERS{$target} = {}; + _install_tracked $target => extends => sub { _load_module($_) for @_; # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA @{*{_getglob("${target}::ISA")}{ARRAY}} = @_; @@ -25,25 +33,32 @@ sub import { 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"}; + $class->_maybe_reset_handlemoose($target); + return; }; - _install_coderef "${target}::with" => sub { + _install_tracked $target => with => sub { require Moo::Role; - Moo::Role->apply_roles_to_package($target, $_[0]); + Moo::Role->apply_roles_to_package($target, @_); + $class->_maybe_reset_handlemoose($target); }; - $MAKERS{$target} = {}; - _install_coderef "${target}::has" => sub { + _install_tracked $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); + $class->_accessor_maker_for($target) + ->generate_method($target, $name, \%spec); + $class->_maybe_reset_handlemoose($target); + return; }; foreach my $type (qw(before after around)) { - _install_coderef "${target}::${type}" => sub { + _install_tracked $target => $type => sub { require Class::Method::Modifiers; _install_modifier($target, $type, @_); + return; }; } { @@ -57,6 +72,43 @@ sub import { } } +sub unimport { + my $target = caller; + _unimport_coderefs($target, $MAKERS{$target}); +} + +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}; @@ -84,13 +136,10 @@ sub _constructor_maker_for { $moo_constructor = 1; # no other constructor, make a Moo one } }; - Method::Generate::Constructor + ($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) @@ -100,6 +149,8 @@ sub _constructor_maker_for { ' 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(@_);'."\n" .' }'."\n" ), ) @@ -200,8 +251,13 @@ L everywhere. Extending a L class or consuming a L should also work. +So should extending a L class or consuming a L. + This means that there is no need for anything like L for Moo -code - Moo and Moose code should simply interoperate without problem. +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 we do. However, these features are new as of 0.91.0 (0.091000) so while serviceable, they are absolutely certain to not be 100% yet; please do report bugs. @@ -287,10 +343,13 @@ 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 @@ -306,9 +365,24 @@ 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 getter 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 @@ -322,6 +396,28 @@ one should do 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 @@ -331,7 +427,10 @@ do something like the following: $_[0] + 1 unless $_[0] % 2 }, -Coerce does not require C to be defined. +Note that L will always fire your coercion - this is to permit +isa 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 @@ -360,6 +459,10 @@ 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. @@ -382,8 +485,10 @@ L Takes a method name which will return true if an attribute has a value. -A common example of this would be to call it C, implying that the -object has a C<$foo> set. +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. =item * builder @@ -396,10 +501,18 @@ Moo will call $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 * clearer Takes a method name which will clear the attribute. +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 * lazy B. Set this if you want values for the attribute to be grabbed @@ -433,6 +546,7 @@ leaks. 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 @@ -465,19 +579,6 @@ aware can take advantage of this. =head1 INCOMPATIBILITIES WITH MOOSE -You can only compose one role at a time. If your application is large or -complex enough to warrant complex composition, you wanted L. Note that -this does not mean you can only compose one role per class - - - with 'FirstRole'; - with 'SecondRole'; - -is absolutely fine, there's just currently no equivalent of Moose's - - with 'FirstRole', 'SecondRole'; - -which composes the two roles together, and then applies them. - 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. L provides a similar API @@ -495,11 +596,27 @@ 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 - Moo succeeds at being small because it explicitly does not -provide a metaprotocol. +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 - override can -be handled by around albeit with a little more typing, and the author considers -augment to be a bad idea. +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(@_); + ... + }; The C method is not provided by default. The author suggests loading L into C (via C for example) and @@ -508,12 +625,18 @@ 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 'lazy'> option supported by L and L. C is not supported since the author considers it a bad idea. -C is not supported since it's a very poor replacement for POD. +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: @@ -555,7 +678,7 @@ on your class. =head1 SUPPORT -IRC: #web-simple on irc.perl.org +IRC: #moose on irc.perl.org =head1 AUTHOR