X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose.pm;h=7756cb48f5df325bf52fcfe800d76d4dd7fa6245;hb=4276ccb4d121b35124dfc060b78cd91975a7e5ef;hp=fcae992ebb305e7fc6382b37c430318602eb126e;hpb=05d9eaf69da40fa42f0a507e2d9bd29dac31a016;p=gitmo%2FMoose.git diff --git a/lib/Moose.pm b/lib/Moose.pm index fcae992..7756cb4 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,13 +4,14 @@ package Moose; use strict; use warnings; -our $VERSION = '0.03_01'; +our $VERSION = '0.09_03'; use Scalar::Util 'blessed', 'reftype'; use Carp 'confess'; use Sub::Name 'subname'; use UNIVERSAL::require; +use Sub::Exporter; use Class::MOP; @@ -18,99 +19,214 @@ use Moose::Meta::Class; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; use Moose::Meta::Attribute; +use Moose::Meta::Instance; use Moose::Object; use Moose::Util::TypeConstraints; -sub import { - shift; - my $pkg = caller(); - - # we should never export to main - return if $pkg eq 'main'; - - #Moose::Util::TypeConstraints->import($pkg); - - # make a subtype for each Moose class - subtype $pkg - => as 'Object' - => where { $_->isa($pkg) }; - - my $meta; - if ($pkg->can('meta')) { - $meta = $pkg->meta(); - (blessed($meta) && $meta->isa('Class::MOP::Class')) - || confess "Whoops, not møøsey enough"; - } - else { - $meta = Moose::Meta::Class->initialize($pkg => ( - ':attribute_metaclass' => 'Moose::Meta::Attribute' - )); - $meta->add_method('meta' => sub { - # re-initialize so it inherits properly - Moose::Meta::Class->initialize($pkg => ( - ':attribute_metaclass' => 'Moose::Meta::Attribute' - )); - }) - } - - # NOTE: - # &alias_method will install the method, but it - # will not name it with - - # handle superclasses - $meta->alias_method('extends' => subname 'Moose::extends' => sub { - _load_all_classes(@_); - $meta->superclasses(@_) - }); - - # handle roles - $meta->alias_method('with' => subname 'Moose::with' => sub { - my ($role) = @_; - _load_all_classes($role); - $role->meta->apply($meta); - }); - - # handle attributes - $meta->alias_method('has' => subname 'Moose::has' => sub { - my ($name, %options) = @_; - $meta->add_attribute($name, %options) - }); - - # handle method modifers - $meta->alias_method('before' => subname 'Moose::before' => sub { - my $code = pop @_; - $meta->add_before_method_modifier($_, $code) for @_; - }); - $meta->alias_method('after' => subname 'Moose::after' => sub { - my $code = pop @_; - $meta->add_after_method_modifier($_, $code) for @_; - }); - $meta->alias_method('around' => subname 'Moose::around' => sub { - my $code = pop @_; - $meta->add_around_method_modifier($_, $code) for @_; - }); - - $meta->alias_method('super' => subname 'Moose::super' => sub {}); - $meta->alias_method('override' => subname 'Moose::override' => sub { - my ($name, $method) = @_; - $meta->add_override_method_modifier($name => $method); - }); - - $meta->alias_method('inner' => subname 'Moose::inner' => sub {}); - $meta->alias_method('augment' => subname 'Moose::augment' => sub { - my ($name, $method) = @_; - $meta->add_augment_method_modifier($name => $method); - }); - - # make sure they inherit from Moose::Object - $meta->superclasses('Moose::Object') - unless $meta->superclasses(); - - # we recommend using these things - # so export them for them - $meta->alias_method('confess' => \&Carp::confess); - $meta->alias_method('blessed' => \&Scalar::Util::blessed); +{ + my $CALLER; + + sub _init_meta { + my $class = $CALLER; + + # make a subtype for each Moose class + subtype $class + => as 'Object' + => where { $_->isa($class) } + unless find_type_constraint($class); + + my $meta; + if ($class->can('meta')) { + # NOTE: + # this is the case where the metaclass pragma + # was used before the 'use Moose' statement to + # override a specific class + $meta = $class->meta(); + (blessed($meta) && $meta->isa('Moose::Meta::Class')) + || confess "Whoops, not møøsey enough"; + } + else { + # NOTE: + # this is broken currently, we actually need + # to allow the possiblity of an inherited + # meta, which will not be visible until the + # user 'extends' first. This needs to have + # more intelligence to it + $meta = Moose::Meta::Class->initialize($class); + $meta->add_method('meta' => sub { + # re-initialize so it inherits properly + Moose::Meta::Class->initialize(blessed($_[0]) || $_[0]); + }) + } + + # make sure they inherit from Moose::Object + $meta->superclasses('Moose::Object') + unless $meta->superclasses(); + } + + my %exports = ( + extends => sub { + my $class = $CALLER; + return subname 'Moose::extends' => sub ($;@) { + _load_all_classes(@_); + my $meta = $class->meta; + foreach my $super (@_) { + # don't bother if it does not have a meta. + next unless $super->can('meta'); + # if it's meta is a vanilla Moose, + # then we can safely ignore it. + next if blessed($super->meta) eq 'Moose::Meta::Class'; + # but if we have anything else, + # we need to check it out ... + unless (# see if of our metaclass is incompatible + ($meta->isa(blessed($super->meta)) && + # and see if our instance metaclass is incompatible + $meta->instance_metaclass->isa($super->meta->instance_metaclass)) && + # ... and if we are just a vanilla Moose + $meta->isa('Moose::Meta::Class')) { + # re-initialize the meta ... + my $super_meta = $super->meta; + # NOTE: + # We might want to consider actually + # transfering any attributes from the + # original meta into this one, but in + # general you should not have any there + # at this point anyway, so it's very + # much an obscure edge case anyway + $meta = $super_meta->reinitialize($class => ( + ':attribute_metaclass' => $super_meta->attribute_metaclass, + ':method_metaclass' => $super_meta->method_metaclass, + ':instance_metaclass' => $super_meta->instance_metaclass, + )); + } + } + $meta->superclasses(@_); + }; + }, + with => sub { + my $class = $CALLER; + return subname 'Moose::with' => sub ($;@) { + my (@roles) = @_; + _load_all_classes(@roles); + ($_->can('meta') && $_->meta->isa('Moose::Meta::Role')) + || confess "You can only consume roles, $_ is not a Moose role" + foreach @roles; + if (scalar @roles == 1) { + $roles[0]->meta->apply($class->meta); + } + else { + Moose::Meta::Role->combine( + map { $_->meta } @roles + )->apply($class->meta); + } + }; + }, + has => sub { + my $class = $CALLER; + return subname 'Moose::has' => sub ($;%) { + my ($name, %options) = @_; + my $meta = $class->meta; + if ($name =~ /^\+(.*)/) { + my $inherited_attr = $meta->find_attribute_by_name($1); + (defined $inherited_attr) + || confess "Could not find an attribute by the name of '$1' to inherit from"; + my $new_attr; + if ($inherited_attr->isa('Moose::Meta::Attribute')) { + $new_attr = $inherited_attr->clone_and_inherit_options(%options); + } + else { + # NOTE: + # kind of a kludge to handle Class::MOP::Attributes + $new_attr = Moose::Meta::Attribute::clone_and_inherit_options( + $inherited_attr, %options + ); + } + $meta->add_attribute($new_attr); + } + else { + if ($options{metaclass}) { + _load_all_classes($options{metaclass}); + $meta->add_attribute($options{metaclass}->new($name, %options)); + } + else { + $meta->add_attribute($name, %options); + } + } + }; + }, + before => sub { + my $class = $CALLER; + return subname 'Moose::before' => sub (@&) { + my $code = pop @_; + my $meta = $class->meta; + $meta->add_before_method_modifier($_, $code) for @_; + }; + }, + after => sub { + my $class = $CALLER; + return subname 'Moose::after' => sub (@&) { + my $code = pop @_; + my $meta = $class->meta; + $meta->add_after_method_modifier($_, $code) for @_; + }; + }, + around => sub { + my $class = $CALLER; + return subname 'Moose::around' => sub (@&) { + my $code = pop @_; + my $meta = $class->meta; + $meta->add_around_method_modifier($_, $code) for @_; + }; + }, + super => sub { + return subname 'Moose::super' => sub {}; + }, + override => sub { + my $class = $CALLER; + return subname 'Moose::override' => sub ($&) { + my ($name, $method) = @_; + $class->meta->add_override_method_modifier($name => $method); + }; + }, + inner => sub { + return subname 'Moose::inner' => sub {}; + }, + augment => sub { + my $class = $CALLER; + return subname 'Moose::augment' => sub (@&) { + my ($name, $method) = @_; + $class->meta->add_augment_method_modifier($name => $method); + }; + }, + confess => sub { + return \&Carp::confess; + }, + blessed => sub { + return \&Scalar::Util::blessed; + } + ); + + my $exporter = Sub::Exporter::build_exporter({ + exports => \%exports, + groups => { + default => [':all'] + } + }); + + sub import { + $CALLER = caller(); + + strict->import; + warnings->import; + + # we should never export to main + return if $CALLER eq 'main'; + + _init_meta(); + + goto $exporter; + } } ## Utility functions @@ -150,10 +266,12 @@ Moose - Moose, it's the new Camel =head1 SYNOPSIS package Point; + use strict; + use warnings; use Moose; - has 'x' => (isa => 'Int', is => 'rw'); - has 'y' => (isa => 'Int', is => 'rw'); + has 'x' => (is => 'rw', isa => 'Int'); + has 'y' => (is => 'rw', isa => 'Int'); sub clear { my $self = shift; @@ -162,23 +280,32 @@ Moose - Moose, it's the new Camel } package Point3D; + use strict; + use warnings; use Moose; extends 'Point'; - has 'z' => (isa => 'Int'); + has 'z' => (is => 'rw', isa => 'Int'); after 'clear' => sub { my $self = shift; - $self->{z} = 0; + $self->z(0); }; =head1 CAVEAT -This is an early release of this module, it still needs -some fine tuning and B more documentation. I am adopting -the I approach with this module, -so keep an eye on your favorite CPAN mirror! +Moose is a rapidly maturing module, and is already being used by +a number of people. It's test suite is growing larger by the day, +and the docs should soon follow. + +This said, Moose is not yet finished, and should still be considered +to be evolving. Much of the outer API is stable, but the internals +are still subject to change (although not without serious thought +given to it). + +For more details, please refer to the L section of +this document. =head1 DESCRIPTION @@ -197,37 +324,26 @@ for Perl 5. This means that Moose not only makes building normal Perl 5 objects better, but it also provides the power of metaclass programming. -=head2 What does Moose stand for?? - -Moose doesn't stand for one thing in particular, however, if you -want, here are a few of my favorites, feel free to contribute -more :) - -=over 4 - -=item Make Other Object Systems Envious - -=item Makes Object Orientation So Easy +=head2 Can I use this in production? Or is this just an experiment? -=item Makes Object Orientation Spiffy- Er (sorry ingy) - -=item Most Other Object Systems Emasculate +Moose is I on the prototypes and experiments I did for the Perl 6 +meta-model, however Moose is B an experiment/prototype, it is +for B. I will be deploying Moose into production environments later +this year, and I have all intentions of using it as my de-facto class +builderfrom now on. -=item My Overcraft Overfilled (with) Some Eels - -=item Moose Often Ovulate Sorta Early +=head2 Is Moose just Perl 6 in Perl 5? -=item Many Overloaded Object Systems Exists - -=item Moose Offers Often Super Extensions - -=back +No. While Moose is very much inspired by Perl 6, it is not. Instead, it +is an OO system for Perl 5. I built Moose because I was tired or writing +the same old boring Perl 5 OO code, and drooling over Perl 6 OO. So +instead of switching to Ruby, I wrote Moose :) =head1 BUILDING CLASSES WITH MOOSE Moose makes every attempt to provide as much convience during class construction/definition, but still stay out of your way if you want -it to. Here are some of the features Moose provides: +it to. Here are a few items to note when building classes with Moose. Unless specified with C, any class which uses Moose will inherit from L. @@ -238,8 +354,6 @@ inherited from L, then this includes properly initializing all instance slots, setting defaults where approprtiate and performing any type constraint checking or coercion. -For more details, see the ever expanding L. - =head1 EXPORTED FUNCTIONS Moose will export a number of functions into the class's namespace, which @@ -261,17 +375,17 @@ actually Ces onto the class's C<@ISA>, whereas C will replace it. This is important to ensure that classes which do not have superclasses properly inherit from L. -=item B +=item B -This will apply a given C<$role> to the local class. Role support is -currently very experimental, see L for more details. +This will apply a given set of C<@roles> to the local class. Role support +is currently under heavy development, see L for more details. =item B This will install an attribute of a given C<$name> into the current class. -The list of C<%options> are the same as those provided by both -L and L, in addition to a -few convience ones provided by Moose which are listed below: +The list of C<%options> are the same as those provided by +L, in addition to the list below which are provided +by Moose (L to be more specific): =over 4 @@ -282,7 +396,7 @@ only). These will create either a read/write accessor or a read-only accessor respectively, using the same name as the C<$name> of the attribute. If you need more control over how your accessors are named, you can use the -I, I and I options inherited from L. +I, I and I options inherited from L. =item I $type_name> @@ -292,6 +406,52 @@ construction, and within any accessors. The C<$type_name> argument must be a string. The string can be either a class name, or a type defined using Moose's type defintion features. +=item I (1|0)> + +This will attempt to use coercion with the supplied type constraint to change +the value passed into any accessors of constructors. You B have supplied +a type constraint in order for this to work. See L +for an example usage. + +=item I $role_name> + +This will accept the name of a role which the value stored in this attribute +is expected to have consumed. + +=item I (1|0)> + +This marks the attribute as being required. This means a value must be supplied +during class construction, and the attribute can never be set to C with +an accessor. + +=item I (1|0)> + +This will tell the class to strore the value of this attribute as a weakened +reference. If an attribute is a weakened reference, it can B also be coerced. + +=item I (1|0)> + +This will tell the class to not create this slot until absolutely nessecary. +If an attribute is marked as lazy it B have a default supplied. + +=item I (1|0)> + +This tells the accessor whether to automatically de-reference the value returned. +This is only legal if your C option is either an C or C. + +=item I $code> + +The trigger option is a CODE reference which will be called after the value of +the attribute is set. The CODE ref will be passed the instance itself, the +updated value and the attribute meta-object (this is for more advanced fiddling +and can typically be ignored in most cases). You can B have a trigger on +a read-only attribute. + +=item I [ @handles ]> + +There is experimental support for attribute delegation using the C +option. More docs to come later. + =back =item B sub { ... }> @@ -343,6 +503,49 @@ C anywhere you need to test for an object's class name. =back +=head1 FUTURE PLANS + +Here is just a sampling of the plans we have in store for Moose: + +=over 4 + +=item * + +Compiling Moose classes/roles into C<.pmc> files for faster loading and execution. + +=item * + +Supporting sealed and finalized classes in Moose. This will allow greater control +of the extensions of frameworks and such. + +=back + +=head1 MISC. + +=head2 What does Moose stand for?? + +Moose doesn't stand for one thing in particular, however, if you +want, here are a few of my favorites, feel free to contribute +more :) + +=over 4 + +=item Make Other Object Systems Envious + +=item Makes Object Orientation So Easy + +=item Makes Object Orientation Spiffy- Er (sorry ingy) + +=item Most Other Object Systems Emasculate + +=item Moose Often Ovulate Sorta Early + +=item Moose Offers Often Super Extensions + +=item Meta Object Orientation Syntax Extensions + +=back + =head1 CAVEATS =over 4 @@ -411,6 +614,10 @@ to cpan-RT. Stevan Little Estevan@iinteractive.comE +Christian Hansen Echansen@cpan.orgE + +Yuval Kogman Enothingmuch@woobling.orgE + =head1 COPYRIGHT AND LICENSE Copyright 2006 by Infinity Interactive, Inc. @@ -420,4 +627,4 @@ L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -=cut \ No newline at end of file +=cut