X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose.pm;h=6d18e15241ecd443798b3bac5aa9bef17503c0e4;hb=f65cb5347d0bfa2de4cafa99ba71bad39a1d1691;hp=08cefe38f157e576a32ab1311ec042c07a8d3f98;hpb=fc5609d2e60a1fbff4b6e3176df4dc89b402cce6;p=gitmo%2FMoose.git diff --git a/lib/Moose.pm b/lib/Moose.pm index 08cefe3..6d18e15 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,114 +4,179 @@ package Moose; use strict; use warnings; -our $VERSION = '0.02'; +our $VERSION = '0.05'; use Scalar::Util 'blessed', 'reftype'; use Carp 'confess'; use Sub::Name 'subname'; +use UNIVERSAL::require; +use Sub::Exporter; + +use Class::MOP; + use Moose::Meta::Class; -use Moose::Meta::SafeMixin; +use Moose::Meta::TypeConstraint; +use Moose::Meta::TypeCoercion; use Moose::Meta::Attribute; use Moose::Object; -use Moose::Util::TypeConstraints ':no_export'; - -# bootstrap the mixin module -Moose::Meta::SafeMixin::mixin(Moose::Meta::Class->meta, 'Moose::Meta::SafeMixin'); - -sub import { - shift; - my $pkg = caller(); - - # we should never export to main - return if $pkg eq 'main'; - - Moose::Util::TypeConstraints->import($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' - )); - }) +use Moose::Util::TypeConstraints; + +{ + my ( $CALLER, %METAS ); + + sub _find_meta { + my $class = $CALLER; + + return $METAS{$class} if exists $METAS{$class}; + + # 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')) { + $meta = $class->meta(); + (blessed($meta) && $meta->isa('Moose::Meta::Class')) + || confess "Whoops, not møøsey enough"; + } + else { + $meta = Moose::Meta::Class->initialize($class); + $meta->add_method('meta' => sub { + # re-initialize so it inherits properly + Moose::Meta::Class->initialize($class); + }) + } + + # make sure they inherit from Moose::Object + $meta->superclasses('Moose::Object') + unless $meta->superclasses(); + + return $METAS{$class} = $meta; + } + + my %exports = ( + extends => sub { + my $meta = _find_meta(); + return subname 'Moose::extends' => sub { + _load_all_classes(@_); + $meta->superclasses(@_) + }; + }, + with => sub { + my $meta = _find_meta(); + return subname 'Moose::with' => sub { + my ($role) = @_; + _load_all_classes($role); + $role->meta->apply($meta); + }; + }, + has => sub { + my $meta = _find_meta(); + return subname 'Moose::has' => sub { + my ($name, %options) = @_; + 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 $meta = _find_meta(); + return subname 'Moose::before' => sub { + my $code = pop @_; + $meta->add_before_method_modifier($_, $code) for @_; + }; + }, + after => sub { + my $meta = _find_meta(); + return subname 'Moose::after' => sub { + my $code = pop @_; + $meta->add_after_method_modifier($_, $code) for @_; + }; + }, + around => sub { + my $meta = _find_meta(); + return subname 'Moose::around' => sub { + my $code = pop @_; + $meta->add_around_method_modifier($_, $code) for @_; + }; + }, + super => sub { + my $meta = _find_meta(); + return subname 'Moose::super' => sub {}; + }, + override => sub { + my $meta = _find_meta(); + return subname 'Moose::override' => sub { + my ($name, $method) = @_; + $meta->add_override_method_modifier($name => $method); + }; + }, + inner => sub { + my $meta = _find_meta(); + return subname 'Moose::inner' => sub {}; + }, + augment => sub { + my $meta = _find_meta(); + return subname 'Moose::augment' => sub { + my ($name, $method) = @_; + $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(); + + # we should never export to main + return if $CALLER eq 'main'; + + goto $exporter; + }; +} + +## Utility functions + +sub _load_all_classes { + foreach my $super (@_) { + # see if this is already + # loaded in the symbol table + next if _is_class_already_loaded($super); + # otherwise require it ... + ($super->require) + || confess "Could not load superclass '$super' because : " . $UNIVERSAL::require::ERROR; + } +} + +sub _is_class_already_loaded { + my $name = shift; + no strict 'refs'; + return 1 if defined ${"${name}::VERSION"} || defined @{"${name}::ISA"}; + foreach (keys %{"${name}::"}) { + next if substr($_, -2, 2) eq '::'; + return 1 if defined &{"${name}::$_"}; } - - # NOTE: - # &alias_method will install the method, but it - # will not name it with - - # handle superclasses - $meta->alias_method('extends' => subname 'Moose::extends' => sub { $meta->superclasses(@_) }); - - # handle mixins - $meta->alias_method('with' => subname 'Moose::with' => sub { $meta->mixin($_[0]) }); - - # handle attributes - $meta->alias_method('has' => subname 'Moose::has' => sub { - my ($name, %options) = @_; - if (exists $options{is}) { - if ($options{is} eq 'ro') { - $options{reader} = $name; - } - elsif ($options{is} eq 'rw') { - $options{accessor} = $name; - } - } - if (exists $options{isa}) { - if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') { - $options{type_constraint} = $options{isa}; - } - else { - $options{type_constraint} = Moose::Util::TypeConstraints::subtype( - Object => Moose::Util::TypeConstraints::where { $_->isa($options{isa}) } - ); - } - } - $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 @_; - }); - - # next methods ... - $meta->alias_method('next_method' => subname 'Moose::next_method' => sub { - my $method_name = (split '::' => (caller(1))[3])[-1]; - my $next_method = $meta->find_next_method_by_name($method_name); - (defined $next_method) - || confess "Could not find next-method for '$method_name'"; - $next_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' => \&confess); - $meta->alias_method('blessed' => \&blessed); + return 0; } 1; @@ -129,8 +194,8 @@ Moose - Moose, it's the new Camel package Point; use Moose; - has 'x' => (isa => Int(), is => 'rw'); - has 'y' => (isa => Int(), is => 'rw'); + has 'x' => (isa => 'Int', is => 'rw'); + has 'y' => (isa => 'Int', is => 'rw'); sub clear { my $self = shift; @@ -143,7 +208,7 @@ Moose - Moose, it's the new Camel extends 'Point'; - has 'z' => (isa => Int()); + has 'z' => (isa => 'Int'); after 'clear' => sub { my $self = shift; @@ -152,7 +217,7 @@ Moose - Moose, it's the new Camel =head1 CAVEAT -This is a B early release of this module, it still needs +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! @@ -182,24 +247,202 @@ more :) =over 4 -=item Makes Other Object Systems Envious +=item Make Other Object Systems Envious =item Makes Object Orientation So Easy -=item Makes Object Orientation Sound Easy +=item Makes Object Orientation Spiffy- Er (sorry ingy) -=item Makes Object Orientation Spiffy- Er +=item Most Other Object Systems Emasculate =item My Overcraft Overfilled (with) Some Eels =item Moose Often Ovulate Sorta Early -=item Most Other Object Systems Emasculate - =item Many Overloaded Object Systems Exists =item Moose Offers Often Super Extensions +=item Meta Object Orientation Syntax Extensions + +=back + +=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: + +Unless specified with C, any class which uses Moose will +inherit from L. + +Moose will also manage all attributes (including inherited ones) that +are defined with C. And assuming that you call C which is +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 +can then be used to set up the class. These functions all work directly +on the current class. + +=over 4 + +=item B + +This is a method which provides access to the current class's metaclass. + +=item B + +This function will set the superclass(es) for the current class. + +This approach is recommended instead of C, because C +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 + +This will apply a given C<$role> to the local class. Role support is +currently very experimental, 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: + +=over 4 + +=item I 'rw'|'ro'> + +The I option accepts either I (for read/write) or I (for read +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. + +=item I $type_name> + +The I option uses Moose's type constraint facilities to set up runtime +type checking for this attribute. Moose will perform the checks during class +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. + +=back + +=item B sub { ... }> + +=item B sub { ... }> + +=item B sub { ... }> + +This three items are syntactic sugar for the before, after and around method +modifier features that L provides. More information on these can +be found in the L documentation for now. + +=item B + +The keyword C is a noop when called outside of an C method. In +the context of an C method, it will call the next most appropriate +superclass method with the same arguments as the original method. + +=item B + +An C method, is a way of explictly saying "I am overriding this +method from my superclass". You can call C within this method, and +it will work as expected. The same thing I be accomplished with a normal +method call and the C pseudo-package, it is really your choice. + +=item B + +The keyword C, much like C, is a no-op outside of the context of +an C method. You can think of C as being the inverse of +C, the details of how C and C work is best described in +the L. + +=item B + +An C method, is a way of explictly saying "I am augmenting this +method from my superclass". Once again, the details of how C and +C work is best described in the L. + +=item B + +This is the C function, and exported here beause I use it +all the time. This feature may change in the future, so you have been warned. + +=item B + +This is the C function, it is exported here beause I +use it all the time. It is highly recommended that this is used instead of +C anywhere you need to test for an object's class name. + +=back + +=head1 CAVEATS + +=over 4 + +=item * + +It should be noted that C and C can B be used in the same +method. However, they can be combined together with the same class hierarchy, +see F for an example. + +The reason that this is so is because C is only valid within a method +with the C modifier, and C will never be valid within an +C method. In fact, C will skip over any C methods +when searching for it's appropriate C. + +This might seem like a restriction, but I am of the opinion that keeping these +two features seperate (but interoperable) actually makes them easy to use since +their behavior is then easier to predict. Time will tell if I am right or not. + +=back + +=head1 ACKNOWLEDGEMENTS + +=over 4 + +=item I blame Sam Vilain for introducing me to the insanity that is meta-models. + +=item I blame Audrey Tang for then encouraging my meta-model habit in #perl6. + +=item Without Yuval "nothingmuch" Kogman this module would not be possible, +and it certainly wouldn't have this name ;P + +=item The basis of the TypeContraints module was Rob Kinyon's idea +originally, I just ran with it. + +=item Thanks to mst & chansen and the whole #moose poose for all the +ideas/feature-requests/encouragement + +=back + +=head1 SEE ALSO + +=over 4 + +=item L documentation + +=item The #moose channel on irc.perl.org + +=item L + +=item L + +This paper (suggested by lbr on #moose) was what lead to the implementation +of the C/C and C/C features. If you really +want to understand this feature, I suggest you read this. + =back =head1 BUGS