X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose.pm;h=ac35d37f85a100623c1fc0a209e20b873ffc3d56;hb=590868a3b1abf3a280d3aff8682043fde74c6e1a;hp=0723860c4fddec1f500a5d80397428ef8e49a410;hpb=54c189df2bd9ff80b30c2781ac92ee26f3d0d785;p=gitmo%2FMoose.git diff --git a/lib/Moose.pm b/lib/Moose.pm index 0723860..ac35d37 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -4,119 +4,183 @@ 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::Attribute; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; +use Moose::Meta::Attribute; 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' - )); - }) +{ + 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"; + ($meta->attribute_metaclass->isa('Moose::Meta::Attribute')) + || confess "Attribute metaclass must be a subclass of Moose::Meta::Attribute"; + } + 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}); + ($options{metaclass}->isa('Moose::Meta::Attribute')) + || confess "Custom attribute metaclass must be a subclass of Moose::Meta::Attribute"; + $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 { - $_->require for @_; - $meta->superclasses(@_) - }); - - # 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}) { - # allow for anon-subtypes here ... - if (blessed($options{isa}) && $options{isa}->isa('Moose::Meta::TypeConstraint')) { - $options{type_constraint} = $options{isa}; - } - else { - # otherwise assume it is a constraint - my $constraint = find_type_constraint($options{isa}); - # if the constraing it not found .... - unless (defined $constraint) { - # assume it is a foreign class, and make - # an anon constraint for it - $constraint = subtype Object => where { $_->isa($options{isa}) }; - } - $options{type_constraint} = $constraint; - } - } - $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 @_; - }); - - # 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); + return 0; } 1; @@ -157,7 +221,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! @@ -203,6 +267,8 @@ more :) =item Moose Offers Often Super Extensions +=item Meta Object Orientation Syntax Extensions + =back =head1 BUILDING CLASSES WITH MOOSE @@ -220,6 +286,8 @@ 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 @@ -241,6 +309,11 @@ 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. @@ -279,6 +352,32 @@ 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 @@ -292,6 +391,27 @@ 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 @@ -321,6 +441,12 @@ ideas/feature-requests/encouragement =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