X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=a1c86dca238e17131b831a36ea950cbe9ff9d13a;hb=f014c28ba9a61d3ff1eceb38e18acb266e803ad4;hp=bbe1b0350a5c833d47acc45f76aec333e7f1da4e;hpb=bcef1f7ccd2532332b64ec22c44b202395733411;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index bbe1b03..a1c86dc 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -9,8 +9,13 @@ use 5.008; use MRO::Compat; use Carp 'confess'; -use Scalar::Util 'weaken', 'reftype', 'blessed'; +use Scalar::Util 'weaken', 'isweak', 'reftype', 'blessed'; +use Data::OptList; +use Try::Tiny; +use Class::MOP::Mixin::AttributeCore; +use Class::MOP::Mixin::HasAttributes; +use Class::MOP::Mixin::HasMethods; use Class::MOP::Class; use Class::MOP::Attribute; use Class::MOP::Method; @@ -24,7 +29,7 @@ BEGIN { *check_package_cache_flag = \&mro::get_pkg_gen; } -our $VERSION = '0.92_01'; +our $VERSION = '1.10'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -32,7 +37,6 @@ our $AUTHORITY = 'cpan:STEVAN'; require XSLoader; XSLoader::load( __PACKAGE__, $XS_VERSION ); - { # Metaclasses are singletons, so we cache them here. # there is no need to worry about destruction though @@ -47,6 +51,7 @@ XSLoader::load( __PACKAGE__, $XS_VERSION ); sub get_metaclass_by_name { $METAS{$_[0]} } sub store_metaclass_by_name { $METAS{$_[0]} = $_[1] } sub weaken_metaclass { weaken($METAS{$_[0]}) } + sub metaclass_is_weak { isweak($METAS{$_[0]}) } sub does_metaclass_exist { exists $METAS{$_[0]} && defined $METAS{$_[0]} } sub remove_metaclass_by_name { delete $METAS{$_[0]}; return } @@ -74,65 +79,62 @@ sub _class_to_pmfile { } sub load_first_existing_class { - my @classes = @_ - or return; + my $classes = Data::OptList::mkopt(\@_) + or return; - foreach my $class (@classes) { - unless ( _is_valid_class_name($class) ) { - my $display = defined($class) ? $class : 'undef'; + foreach my $class (@{ $classes }) { + my $name = $class->[0]; + unless ( _is_valid_class_name($name) ) { + my $display = defined($name) ? $name : 'undef'; confess "Invalid class name ($display)"; } } my $found; my %exceptions; - for my $class (@classes) { - my $e = _try_load_one_class($class); - if ($e) { - my $pmfile = _class_to_pmfile($class); - $exceptions{$class} = $e; - last if $e !~ /^Can't locate \Q$pmfile\E in \@INC/; + for my $class (@{ $classes }) { + my ($name, $options) = @{ $class }; + + if ($options) { + return $name if is_class_loaded($name, $options); + if (is_class_loaded($name)) { + # we already know it's loaded and too old, but we call + # ->VERSION anyway to generate the exception for us + $name->VERSION($options->{-version}); + } } else { - $found = $class; - last; + return $name if is_class_loaded($name); } - } - - return $found if $found; - confess join( - "\n", - map { - sprintf( - "Could not load class (%s) because : %s", $_, - $exceptions{$_} - ) + my $file = _class_to_pmfile($name); + return $name if try { + local $SIG{__DIE__}; + require $file; + $name->VERSION($options->{-version}) + if defined $options->{-version}; + return 1; + } + catch { + unless (/^Can't locate \Q$file\E in \@INC/) { + confess "Couldn't load class ($name) because: $_"; } - grep { - exists $exceptions{$_} - } @classes - ); -} - -sub _try_load_one_class { - my $class = shift; - return if is_class_loaded($class); - - my $file = _class_to_pmfile($class); + return; + }; + } - return do { - local $@; - local $SIG{__DIE__}; - eval { require($file) }; - $@; - }; + if ( @{ $classes } > 1 ) { + my @list = map { $_->[0] } @{ $classes }; + confess "Can't locate any of @list in \@INC (\@INC contains: @INC)."; + } else { + confess "Can't locate " . _class_to_pmfile($classes->[0]->[0]) . " in \@INC (\@INC contains: @INC)."; + } } sub load_class { - load_first_existing_class($_[0]); + load_first_existing_class($_[0], ref $_[1] ? $_[1] : ()); # This is done to avoid breaking code which checked the return value. Said # code is dumb. The return value was _always_ true, since it dies on @@ -177,68 +179,101 @@ sub _is_valid_class_name { # inherit them using _construct_instance ## -------------------------------------------------------- -## Class::MOP::Package +## Class::MOP::Mixin::HasMethods -Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('package' => ( +Class::MOP::Mixin::HasMethods->meta->add_attribute( + Class::MOP::Attribute->new('_methods' => ( reader => { - # NOTE: we need to do this in order - # for the instance meta-object to - # not fall into meta-circular death - # + # NOTE: # we just alias the original method # rather than re-produce it here - 'name' => \&Class::MOP::Package::name + '_full_method_map' => \&Class::MOP::Mixin::HasMethods::_full_method_map }, + default => sub { {} } )) ); -Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('namespace' => ( - reader => { +Class::MOP::Mixin::HasMethods->meta->add_attribute( + Class::MOP::Attribute->new('method_metaclass' => ( + reader => { # NOTE: # we just alias the original method # rather than re-produce it here - 'namespace' => \&Class::MOP::Package::namespace + 'method_metaclass' => \&Class::MOP::Mixin::HasMethods::method_metaclass }, - init_arg => undef, - default => sub { \undef } + default => 'Class::MOP::Method', )) ); -Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('_methods' => ( +Class::MOP::Mixin::HasMethods->meta->add_attribute( + Class::MOP::Attribute->new('wrapped_method_metaclass' => ( reader => { # NOTE: # we just alias the original method # rather than re-produce it here - '_full_method_map' => \&Class::MOP::Package::_full_method_map + 'wrapped_method_metaclass' => \&Class::MOP::Mixin::HasMethods::wrapped_method_metaclass }, - default => sub { {} } + default => 'Class::MOP::Method::Wrapped', )) ); -Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('method_metaclass' => ( +## -------------------------------------------------------- +## Class::MOP::Mixin::HasMethods + +Class::MOP::Mixin::HasAttributes->meta->add_attribute( + Class::MOP::Attribute->new('attributes' => ( + reader => { + # NOTE: we need to do this in order + # for the instance meta-object to + # not fall into meta-circular death + # + # we just alias the original method + # rather than re-produce it here + '_attribute_map' => \&Class::MOP::Mixin::HasAttributes::_attribute_map + }, + default => sub { {} } + )) +); + +Class::MOP::Mixin::HasAttributes->meta->add_attribute( + Class::MOP::Attribute->new('attribute_metaclass' => ( reader => { # NOTE: # we just alias the original method # rather than re-produce it here - 'method_metaclass' => \&Class::MOP::Package::method_metaclass + 'attribute_metaclass' => \&Class::MOP::Mixin::HasAttributes::attribute_metaclass }, - default => 'Class::MOP::Method', + default => 'Class::MOP::Attribute', )) ); +## -------------------------------------------------------- +## Class::MOP::Package + Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('wrapped_method_metaclass' => ( + Class::MOP::Attribute->new('package' => ( reader => { + # NOTE: we need to do this in order + # for the instance meta-object to + # not fall into meta-circular death + # + # we just alias the original method + # rather than re-produce it here + 'name' => \&Class::MOP::Package::name + }, + )) +); + +Class::MOP::Package->meta->add_attribute( + Class::MOP::Attribute->new('namespace' => ( + reader => { # NOTE: # we just alias the original method # rather than re-produce it here - 'wrapped_method_metaclass' => \&Class::MOP::Package::wrapped_method_metaclass + 'namespace' => \&Class::MOP::Package::namespace }, - default => 'Class::MOP::Method::Wrapped', + init_arg => undef, + default => sub { \undef } )) ); @@ -291,21 +326,6 @@ Class::MOP::Module->meta->add_attribute( ## Class::MOP::Class Class::MOP::Class->meta->add_attribute( - Class::MOP::Attribute->new('attributes' => ( - reader => { - # NOTE: we need to do this in order - # for the instance meta-object to - # not fall into meta-circular death - # - # we just alias the original method - # rather than re-produce it here - 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map - }, - default => sub { {} } - )) -); - -Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->new('superclasses' => ( accessor => { # NOTE: @@ -319,18 +339,6 @@ Class::MOP::Class->meta->add_attribute( ); Class::MOP::Class->meta->add_attribute( - Class::MOP::Attribute->new('attribute_metaclass' => ( - reader => { - # NOTE: - # we just alias the original method - # rather than re-produce it here - 'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass - }, - default => 'Class::MOP::Attribute', - )) -); - -Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->new('instance_metaclass' => ( reader => { # NOTE: we need to do this in order @@ -388,9 +396,8 @@ Class::MOP::Class->meta->add_attribute( # _construct_class_instance method. ## -------------------------------------------------------- -## Class::MOP::Attribute - -Class::MOP::Attribute->meta->add_attribute( +## Class::MOP::Mixin::AttributeCore +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('name' => ( reader => { # NOTE: we need to do this in order @@ -399,106 +406,108 @@ Class::MOP::Attribute->meta->add_attribute( # # we just alias the original method # rather than re-produce it here - 'name' => \&Class::MOP::Attribute::name + 'name' => \&Class::MOP::Mixin::AttributeCore::name } )) ); -Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('associated_class' => ( - reader => { - # NOTE: we need to do this in order - # for the instance meta-object to - # not fall into meta-circular death - # - # we just alias the original method - # rather than re-produce it here - 'associated_class' => \&Class::MOP::Attribute::associated_class - } - )) -); - -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('accessor' => ( - reader => { 'accessor' => \&Class::MOP::Attribute::accessor }, - predicate => { 'has_accessor' => \&Class::MOP::Attribute::has_accessor }, + reader => { 'accessor' => \&Class::MOP::Mixin::AttributeCore::accessor }, + predicate => { 'has_accessor' => \&Class::MOP::Mixin::AttributeCore::has_accessor }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('reader' => ( - reader => { 'reader' => \&Class::MOP::Attribute::reader }, - predicate => { 'has_reader' => \&Class::MOP::Attribute::has_reader }, + reader => { 'reader' => \&Class::MOP::Mixin::AttributeCore::reader }, + predicate => { 'has_reader' => \&Class::MOP::Mixin::AttributeCore::has_reader }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('initializer' => ( - reader => { 'initializer' => \&Class::MOP::Attribute::initializer }, - predicate => { 'has_initializer' => \&Class::MOP::Attribute::has_initializer }, + reader => { 'initializer' => \&Class::MOP::Mixin::AttributeCore::initializer }, + predicate => { 'has_initializer' => \&Class::MOP::Mixin::AttributeCore::has_initializer }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('definition_context' => ( - reader => { 'definition_context' => \&Class::MOP::Attribute::definition_context }, + reader => { 'definition_context' => \&Class::MOP::Mixin::AttributeCore::definition_context }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('writer' => ( - reader => { 'writer' => \&Class::MOP::Attribute::writer }, - predicate => { 'has_writer' => \&Class::MOP::Attribute::has_writer }, + reader => { 'writer' => \&Class::MOP::Mixin::AttributeCore::writer }, + predicate => { 'has_writer' => \&Class::MOP::Mixin::AttributeCore::has_writer }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('predicate' => ( - reader => { 'predicate' => \&Class::MOP::Attribute::predicate }, - predicate => { 'has_predicate' => \&Class::MOP::Attribute::has_predicate }, + reader => { 'predicate' => \&Class::MOP::Mixin::AttributeCore::predicate }, + predicate => { 'has_predicate' => \&Class::MOP::Mixin::AttributeCore::has_predicate }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('clearer' => ( - reader => { 'clearer' => \&Class::MOP::Attribute::clearer }, - predicate => { 'has_clearer' => \&Class::MOP::Attribute::has_clearer }, + reader => { 'clearer' => \&Class::MOP::Mixin::AttributeCore::clearer }, + predicate => { 'has_clearer' => \&Class::MOP::Mixin::AttributeCore::has_clearer }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('builder' => ( - reader => { 'builder' => \&Class::MOP::Attribute::builder }, - predicate => { 'has_builder' => \&Class::MOP::Attribute::has_builder }, + reader => { 'builder' => \&Class::MOP::Mixin::AttributeCore::builder }, + predicate => { 'has_builder' => \&Class::MOP::Mixin::AttributeCore::has_builder }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('init_arg' => ( - reader => { 'init_arg' => \&Class::MOP::Attribute::init_arg }, - predicate => { 'has_init_arg' => \&Class::MOP::Attribute::has_init_arg }, + reader => { 'init_arg' => \&Class::MOP::Mixin::AttributeCore::init_arg }, + predicate => { 'has_init_arg' => \&Class::MOP::Mixin::AttributeCore::has_init_arg }, )) ); -Class::MOP::Attribute->meta->add_attribute( +Class::MOP::Mixin::AttributeCore->meta->add_attribute( Class::MOP::Attribute->new('default' => ( # default has a custom 'reader' method ... - predicate => { 'has_default' => \&Class::MOP::Attribute::has_default }, + predicate => { 'has_default' => \&Class::MOP::Mixin::AttributeCore::has_default }, + )) +); + +Class::MOP::Mixin::AttributeCore->meta->add_attribute( + Class::MOP::Attribute->new('insertion_order' => ( + reader => { 'insertion_order' => \&Class::MOP::Mixin::AttributeCore::insertion_order }, + writer => { '_set_insertion_order' => \&Class::MOP::Mixin::AttributeCore::_set_insertion_order }, + predicate => { 'has_insertion_order' => \&Class::MOP::Mixin::AttributeCore::has_insertion_order }, )) ); +## -------------------------------------------------------- +## Class::MOP::Attribute Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('associated_methods' => ( - reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods }, - default => sub { [] } + Class::MOP::Attribute->new('associated_class' => ( + reader => { + # NOTE: we need to do this in order + # for the instance meta-object to + # not fall into meta-circular death + # + # we just alias the original method + # rather than re-produce it here + 'associated_class' => \&Class::MOP::Attribute::associated_class + } )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('insertion_order' => ( - reader => { 'insertion_order' => \&Class::MOP::Attribute::insertion_order }, - writer => { '_set_insertion_order' => \&Class::MOP::Attribute::_set_insertion_order }, - predicate => { 'has_insertion_order' => \&Class::MOP::Attribute::has_insertion_order }, + Class::MOP::Attribute->new('associated_methods' => ( + reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods }, + default => sub { [] } )) ); @@ -540,13 +549,6 @@ Class::MOP::Method->meta->add_attribute( )) ); -Class::MOP::Method->meta->add_method('clone' => sub { - my $self = shift; - my $clone = $self->meta->clone_object($self, @_); - $clone->_set_original_method($self); - return $clone; -}); - ## -------------------------------------------------------- ## Class::MOP::Method::Wrapped @@ -663,6 +665,18 @@ Class::MOP::Instance->meta->add_attribute( ), ); +## -------------------------------------------------------- +## Class::MOP::Object + +# need to replace the meta method there with a real meta method object +Class::MOP::Object->meta->_add_meta_method('meta'); + +## -------------------------------------------------------- +## Class::MOP::Mixin + +# need to replace the meta method there with a real meta method object +Class::MOP::Mixin->meta->_add_meta_method('meta'); + require Class::MOP::Deprecated unless our $no_deprecated; # we need the meta instance of the meta instance to be created now, in order @@ -699,6 +713,19 @@ $_->meta->make_immutable( Class::MOP::Method::Accessor Class::MOP::Method::Constructor Class::MOP::Method::Wrapped + + Class::MOP::Method::Meta +/; + +$_->meta->make_immutable( + inline_constructor => 0, + constructor_name => undef, + inline_accessors => 0, +) for qw/ + Class::MOP::Mixin + Class::MOP::Mixin::AttributeCore + Class::MOP::Mixin::HasAttributes + Class::MOP::Mixin::HasMethods /; 1; @@ -828,6 +855,18 @@ metaclass compatibility both upwards and downwards. | A |<----| B | +---------+ +---------+ +In actuality, I of a class's metaclasses must be compatible, +not just the class metaclass. That includes the instance, attribute, +and method metaclasses, as well as the constructor and destructor +classes. + +C will attempt to fix some simple types of +incompatibilities. If all the metaclasses for the parent class are +I of the child's metaclasses then we can simply replace +the child's metaclasses with the parent's. In addition, if the child +is missing a metaclass that the parent has, we can also just make the +child use the parent's metaclass. + As I said this is a highly esoteric topic and one you will only run into if you do a lot of subclassing of L. If you are interested in why this is an issue see the paper I. =over 4 -=item B +=item B This will load the specified C<$class_name>, if it is not already loaded (as reported by C). This function can be used @@ -919,9 +958,15 @@ unconditionally. If the module cannot be loaded, an exception is thrown. -For historical reasons, this function returns explicitly returns a true value. +You can pass a hash reference with options as second argument. The +only option currently recognised is C<-version>, which will ensure +that the loaded class has at least the required version. + +See also L. + +For historical reasons, this function explicitly returns a true value. -=item B +=item B Returns a boolean indicating whether or not C<$class_name> has been loaded. @@ -933,6 +978,12 @@ positives. In particular, loading any of the core L modules will cause most of the rest of the core L modules to falsely report having been loaded, due to the way the base L module works. +You can pass a hash reference with options as second argument. The +only option currently recognised is C<-version>, which will ensure +that the loaded class has at least the required version. + +See also L. + =item B This function returns two values, the name of the package the C<$code> @@ -959,6 +1010,8 @@ variable which is not package specific. =item B +=item B + B Given a list of class names, this function will attempt to load each @@ -967,6 +1020,13 @@ one in turn. If it finds a class it can load, it will return that class' name. If none of the classes can be loaded, it will throw an exception. +Additionally, you can pass a hash reference with options after each +class name. Currently, only C<-version> is recognised and will ensure +that the loaded class has at least the required version. If the class +version is not sufficient, an exception will be raised. + +See also L. + =back =head2 Metaclass cache functions @@ -1009,6 +1069,11 @@ store a weakened reference in the metaclass cache. This function will weaken the reference to the metaclass stored in C<$name>. +=item B + +Returns true if the metaclass for C<$name> has been weakened +(via C). + =item B This will return true of there exists a metaclass stored in the @@ -1020,6 +1085,17 @@ This will remove the metaclass stored in the C<$name> key. =back +=head2 Class Loading Options + +=over 4 + +=item -version + +Can be used to pass a minimum required version that will be checked +against the class version after it was loaded. + +=back + =head1 SEE ALSO =head2 Books @@ -1074,7 +1150,7 @@ L =item L -=item L +=item L =back @@ -1147,7 +1223,7 @@ Dylan Hardison =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L