X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoo.pm;h=f4023cba31ee26110257b58578e0843eb0b83992;hb=64284a1b21ce94c351f555f0e74929e4ff8ad323;hp=f01086ec26a17a1dee721c6eca10b10df69610f4;hpb=5ef50c4ddcdd784fbc55cd884e37c1d5c39494a9;p=gitmo%2FMoo.git diff --git a/lib/Moo.pm b/lib/Moo.pm index f01086e..f4023cb 100644 --- a/lib/Moo.pm +++ b/lib/Moo.pm @@ -2,10 +2,14 @@ package Moo; use strictures 1; use Moo::_Utils; +use B 'perlstring'; +use Sub::Defer (); -our $VERSION = '0.009001'; # 0.9.1 +our $VERSION = '0.091001'; # 0.91.1 $VERSION = eval $VERSION; +require Moo::sification; + our %MAKERS; sub import { @@ -13,27 +17,30 @@ sub import { my $class = shift; strictures->import; return if $MAKERS{$target}; # already exported into this package - *{_getglob("${target}::extends")} = sub { + _install_coderef "${target}::extends" => sub { _load_module($_) for @_; - *{_getglob("${target}::ISA")} = \@_; + # 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 { + _install_coderef "${target}::with" => sub { require Moo::Role; - die "Only one role supported at a time by with" if @_ > 1; - Moo::Role->apply_role_to_package($target, $_[0]); + Moo::Role->apply_roles_to_package($target, $_[0]); }; $MAKERS{$target} = {}; - *{_getglob("${target}::has")} = sub { + _install_coderef "${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); }; foreach my $type (qw(before after around)) { - *{_getglob "${target}::${type}"} = sub { + _install_coderef "${target}::${type}" => sub { require Class::Method::Modifiers; _install_modifier($target, $type, @_); }; @@ -44,53 +51,93 @@ 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 _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" + .' }'."\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) -=head1 WARNING WARNING WARNING - -This is a 0.9 release because we're fairly sure it works. For us. Until it's -tested in the wild, we make no guarantees it also works for you. - -If this module does something unexpected, please submit a failing test. - -But if it eats your cat, sleeps with your boyfriend, or pushes grandma down -the stairs to save her from the terrible secret of space, it's not our fault. - =head1 SYNOPSIS package Cat::Food; @@ -145,6 +192,50 @@ thirds of L. Unlike C this module does not aim at full L compatibility. See L for more details. +=head1 WHY MOO EXISTS + +If you want a full object system with a rich Metaprotocol, L is +already wonderful. + +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. + +By Moo 1.0 I intend to have Moo's equivalent of L built in - +if Moose gets loaded, any Moo class or role will act as a Moose equivalent +if treated as such. + +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 @@ -157,14 +248,42 @@ or =head2 BUILDARGS -This feature from Moose is not yet supported. + sub BUILDARGS { + my ( $class, @args ) = @_; + + unshift @args, "attr1" if @args % 2 == 1; + + return { @args }; + }; + + Foo::Bar->new( 3 ); -=head2 BUILDALL +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 @@ -209,7 +328,7 @@ 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 +accessor that will not respond to arguments; to be clear: a getter only. C will create a perlish getter/setter. =item * isa @@ -226,10 +345,6 @@ L =item * coerce -This Moose feature is not yet supported - -=begin hide - Takes a coderef which is meant to coerce the attribute. The basic idea is to do something like the following: @@ -237,14 +352,34 @@ do something like the following: $_[0] + 1 unless $_[0] % 2 }, +Coerce does not require C to be defined. + L -=end hide +=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. Note that Moose also passes the old value, if any; this feature is not yet supported. @@ -296,6 +431,18 @@ another attribute to be set. B. Set this if the attribute must be passed on instantiation. +=item * reader + +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 * writer + +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 * weak_ref B. Set this if you want the reference that the attribute contains to @@ -340,14 +487,32 @@ 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. +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'; -There is no complex type system. C is verified with a coderef, if you +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. +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 @@ -357,6 +522,10 @@ 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. @@ -366,3 +535,81 @@ manually set all the options it implies. 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. + +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 + +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) + +=head1 COPYRIGHT + +Copyright (c) 2010-2011 the Moo L and L +as listed above. + +=head1 LICENSE + +This library is free software and may be distributed under the same terms +as perl itself. + +=cut