X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=d3fdf355dbb8d20ff28fc95f4d0aff30b96c1751;hb=db130c70dd57d254d55a30d0a6c58df44505ce8a;hp=d79c0ac1bb9d6e1eee9600ef53fd11018e991e0d;hpb=4fbd4b9bca7c0d3fead3f42a49e3671a6e7fc54f;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index d79c0ac..d3fdf35 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -10,6 +10,7 @@ use MRO::Compat; use Carp 'confess'; use Scalar::Util 'weaken', 'reftype', 'blessed'; +use Data::OptList; use Try::Tiny; use Class::MOP::Mixin::AttributeCore; @@ -28,7 +29,7 @@ BEGIN { *check_package_cache_flag = \&mro::get_pkg_gen; } -our $VERSION = '0.98'; +our $VERSION = '1.05'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -36,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 @@ -78,12 +78,13 @@ sub _class_to_pmfile { } sub load_first_existing_class { - my @classes = @_ + 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)"; } } @@ -91,34 +92,48 @@ sub load_first_existing_class { my $found; my %exceptions; - for my $class (@classes) { - my $file = _class_to_pmfile($class); + for my $class (@{ $classes }) { + my ($name, $options) = @{ $class }; - return $class if is_class_loaded($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 { + return $name if is_class_loaded($name); + } - return $class if try { + 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 ($class) because: $_"; + confess "Couldn't load class ($name) because: $_"; } return; }; } - if ( @classes > 1 ) { - confess "Can't locate any of @classes in \@INC (\@INC contains: @INC)."; + 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]) . " in \@INC (\@INC contains: @INC)."; + 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 @@ -533,13 +548,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 @@ -832,6 +840,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 @@ -923,9 +943,15 @@ unconditionally. If the module cannot be loaded, an exception is thrown. +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. @@ -937,6 +963,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> @@ -963,6 +995,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 @@ -971,6 +1005,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 @@ -1024,6 +1065,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