X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoo.pm;h=545e80a3ead06dcce5437361a6794515a91bf5f7;hb=f9755246a7eec67300ed639a439be560a12551db;hp=3f53398c8edf3374c32c53425d51e4277f023eeb;hpb=673eb4988f20b57235a6e8b9ff7035b95ba98baa;p=gitmo%2FMoo.git diff --git a/lib/Moo.pm b/lib/Moo.pm index 3f53398..545e80a 100644 --- a/lib/Moo.pm +++ b/lib/Moo.pm @@ -3,10 +3,13 @@ package Moo; use strictures 1; use Moo::_Utils; use B 'perlstring'; +use Sub::Defer (); -our $VERSION = '0.009012'; # 0.9.12 +our $VERSION = '0.091002'; # 0.91.2 $VERSION = eval $VERSION; +require Moo::sification; + our %MAKERS; sub import { @@ -14,49 +17,76 @@ sub import { my $class = shift; strictures->import; return if $MAKERS{$target}; # already exported into this package - *{_getglob("${target}::extends")} = sub { + _install_coderef "${target}::extends" => "Moo::extends" => sub { _load_module($_) for @_; # 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}); + } }; - *{_getglob("${target}::with")} = sub { - { local $@; require Moo::Role; } - die "Only one role supported at a time by with" if @_ > 1; - Moo::Role->apply_role_to_package($target, $_[0]); + _install_coderef "${target}::with" => "Moo::with" => sub { + require Moo::Role; + Moo::Role->apply_roles_to_package($target, $_[0]); }; $MAKERS{$target} = {}; - *{_getglob("${target}::has")} = sub { + _install_coderef "${target}::has" => "Moo::has" => sub { my ($name, %spec) = @_; - ($MAKERS{$target}{accessor} ||= do { - { local $@; 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); }; foreach my $type (qw(before after around)) { - *{_getglob "${target}::${type}"} = sub { - { local $@; require Class::Method::Modifiers; } + _install_coderef "${target}::${type}" => "Moo::${type}" => sub { + require Class::Method::Modifiers; _install_modifier($target, $type, @_); }; } { no strict 'refs'; @{"${target}::ISA"} = do { - { local $@; require Moo::Object; } ('Moo::Object'); + require Moo::Object; ('Moo::Object'); } unless @{"${target}::ISA"}; } + if ($INC{'Moo/HandleMoose.pm'}) { + Moo::HandleMoose::inject_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 { - { - local $@; - require Method::Generate::Constructor; - require Sub::Defer; - } + require Method::Generate::Constructor; + require Sub::Defer; my ($moo_constructor, $con); if ($select_super && $MAKERS{$select_super}) { @@ -78,20 +108,20 @@ 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 { - { local $@; 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_generator => ( - $class.'->_constructor_maker_for($class,'.perlstring($target).')' + subconstructor_handler => ( + ' if ($Moo::MAKERS{$class}) {'."\n" + .' '.$class.'->_constructor_maker_for($class,'.perlstring($target).');'."\n" + .' return $class->new(@_)'.";\n" + .' }'."\n" ), ) ->install_delayed @@ -182,6 +212,30 @@ 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 - NEW, EXPERIMENTAL + +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 it ever realising you aren't using +L everywhere. + +Extending a L class or consuming a L should also work. + +This means that there is no need for anything like L for Moo +code - Moo and Moose code should simply interoperate without problem. + +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. + +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, only in a top level script as a temporary measure while +you send a bug report. + =head1 IMPORTED METHODS =head2 new @@ -194,13 +248,12 @@ or =head2 BUILDARGS - around BUILDARGS => sub { - my $orig = shift; + sub BUILDARGS { my ( $class, @args ) = @_; unshift @args, "attr1" if @args % 2 == 1; - return $class->$orig(@args); + return { @args }; }; Foo::Bar->new( 3 ); @@ -255,10 +308,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 @@ -324,8 +380,9 @@ Takes a hashref =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. Note that Moose also passes the old value, if any; this feature is not yet supported. @@ -432,33 +489,48 @@ 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. - -There is no complex type system. C is verified with a coderef, if you +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); + +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. +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 - 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. +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 '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 ignors it as well, so this +is arguably not an incompatibility. Handling of warnings: when you C we enable FATAL warnings. The nearest similar invocation for L would be: @@ -468,7 +540,7 @@ similar invocation for L would be: 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. So if you: +module L as of its version 0.009+. So if you: package MyClass; use Moo; @@ -481,6 +553,27 @@ The nearest L invocation would be: 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 + +IRC: #web-simple on irc.perl.org + =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT) @@ -503,6 +596,8 @@ ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) +perigrin - Chris Prather (cpan:PERIGRIN) + =head1 COPYRIGHT Copyright (c) 2010-2011 the Moo L and L