X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=ead8390207447e8fdc6a7c58d8b51ccdd612e5d4;hb=stable%2F2.04;hp=dea5cc9cb4ef39a8f43526e8a1fc09eb82b475e6;hpb=38bf2a2585e26a47c919fd4c286b7716acb51c00;p=gitmo%2FMoose.git

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index dea5cc9..ead8390 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -9,6 +9,7 @@ use 5.008;
 use MRO::Compat;
 
 use Carp          'confess';
+use Class::Load   ();
 use Scalar::Util  'weaken', 'isweak', 'reftype', 'blessed';
 use Data::OptList;
 use Try::Tiny;
@@ -29,13 +30,9 @@ BEGIN {
     *check_package_cache_flag = \&mro::get_pkg_gen;
 }
 
-our $AUTHORITY = 'cpan:STEVAN';
-
 XSLoader::load(
     'Moose',
-    $Moose::{VERSION}   ? $Moose::{VERSION}
-    : $ENV{_XS_VERSION} ? $ENV{_XS_VERSION}
-    : ()
+    $Class::MOP::{VERSION} ? ${ $Class::MOP::{VERSION} } : ()
 );
 
 {
@@ -70,89 +67,25 @@ XSLoader::load(
     # because I don't yet see a good reason to do so.
 }
 
-sub _class_to_pmfile {
-    my $class = shift;
-
-    my $file = $class . '.pm';
-    $file =~ s{::}{/}g;
-
-    return $file;
+sub load_class {
+    goto &Class::Load::load_class;
 }
 
 sub load_first_existing_class {
-    my $classes = Data::OptList::mkopt(\@_)
-      or return;
-
-    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 ($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 {
-            return $name if is_class_loaded($name);
-        }
-
-        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: $_";
-            }
-
-            return;
-        };
-    }
-
-    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).";
-    }
+    goto &Class::Load::load_first_existing_class;
 }
 
-sub load_class {
-    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
-    # failure!
-    return 1;
+sub is_class_loaded {
+    goto &Class::Load::is_class_loaded;
 }
 
-sub _is_valid_class_name {
-    my $class = shift;
-
-    return 0 if ref($class);
-    return 0 unless defined($class);
-    return 0 unless length($class);
-
-    return 1 if $class =~ /^\w+(?:::\w+)*$/;
+sub _definition_context {
+    my %context;
+    @context{qw(package file line)} = caller(1);
 
-    return 0;
+    return (
+        definition_context => \%context,
+    );
 }
 
 ## ----------------------------------------------------------------------------
@@ -190,7 +123,8 @@ Class::MOP::Mixin::HasMethods->meta->add_attribute(
             # rather than re-produce it here
             '_method_map' => \&Class::MOP::Mixin::HasMethods::_method_map
         },
-        default => sub { {} }
+        default => sub { {} },
+        _definition_context(),
     ))
 );
 
@@ -203,6 +137,7 @@ Class::MOP::Mixin::HasMethods->meta->add_attribute(
             'method_metaclass' => \&Class::MOP::Mixin::HasMethods::method_metaclass
         },
         default  => 'Class::MOP::Method',
+        _definition_context(),
     ))
 );
 
@@ -215,6 +150,7 @@ Class::MOP::Mixin::HasMethods->meta->add_attribute(
             'wrapped_method_metaclass' => \&Class::MOP::Mixin::HasMethods::wrapped_method_metaclass
         },
         default  => 'Class::MOP::Method::Wrapped',
+        _definition_context(),
     ))
 );
 
@@ -232,7 +168,8 @@ Class::MOP::Mixin::HasAttributes->meta->add_attribute(
             # rather than re-produce it here
             '_attribute_map' => \&Class::MOP::Mixin::HasAttributes::_attribute_map
         },
-        default  => sub { {} }
+        default  => sub { {} },
+        _definition_context(),
     ))
 );
 
@@ -245,6 +182,7 @@ Class::MOP::Mixin::HasAttributes->meta->add_attribute(
             'attribute_metaclass' => \&Class::MOP::Mixin::HasAttributes::attribute_metaclass
         },
         default  => 'Class::MOP::Attribute',
+        _definition_context(),
     ))
 );
 
@@ -262,6 +200,7 @@ Class::MOP::Package->meta->add_attribute(
             # rather than re-produce it here
             'name' => \&Class::MOP::Package::name
         },
+        _definition_context(),
     ))
 );
 
@@ -274,7 +213,8 @@ Class::MOP::Package->meta->add_attribute(
             'namespace' => \&Class::MOP::Package::namespace
         },
         init_arg => undef,
-        default  => sub { \undef }
+        default  => sub { \undef },
+        _definition_context(),
     ))
 );
 
@@ -300,7 +240,8 @@ Class::MOP::Module->meta->add_attribute(
             'version' => \&Class::MOP::Module::version
         },
         init_arg => undef,
-        default  => sub { \undef }
+        default  => sub { \undef },
+        _definition_context(),
     ))
 );
 
@@ -319,7 +260,8 @@ Class::MOP::Module->meta->add_attribute(
             'authority' => \&Class::MOP::Module::authority
         },
         init_arg => undef,
-        default  => sub { \undef }
+        default  => sub { \undef },
+        _definition_context(),
     ))
 );
 
@@ -335,7 +277,8 @@ Class::MOP::Class->meta->add_attribute(
             'superclasses' => \&Class::MOP::Class::superclasses
         },
         init_arg => undef,
-        default  => sub { \undef }
+        default  => sub { \undef },
+        _definition_context(),
     ))
 );
 
@@ -351,6 +294,7 @@ Class::MOP::Class->meta->add_attribute(
             'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
         },
         default  => 'Class::MOP::Instance',
+        _definition_context(),
     ))
 );
 
@@ -360,6 +304,7 @@ Class::MOP::Class->meta->add_attribute(
             'immutable_trait' => \&Class::MOP::Class::immutable_trait
         },
         default => "Class::MOP::Class::Immutable::Trait",
+        _definition_context(),
     ))
 );
 
@@ -369,6 +314,7 @@ Class::MOP::Class->meta->add_attribute(
             'constructor_name' => \&Class::MOP::Class::constructor_name,
         },
         default => "new",
+        _definition_context(),
     ))
 );
 
@@ -378,6 +324,7 @@ Class::MOP::Class->meta->add_attribute(
             'constructor_class' => \&Class::MOP::Class::constructor_class,
         },
         default => "Class::MOP::Method::Constructor",
+        _definition_context(),
     ))
 );
 
@@ -387,6 +334,7 @@ Class::MOP::Class->meta->add_attribute(
         reader   => {
             'destructor_class' => \&Class::MOP::Class::destructor_class,
         },
+        _definition_context(),
     ))
 );
 
@@ -408,7 +356,8 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
             # we just alias the original method
             # rather than re-produce it here
             'name' => \&Class::MOP::Mixin::AttributeCore::name
-        }
+        },
+        _definition_context(),
     ))
 );
 
@@ -416,6 +365,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('accessor' => (
         reader    => { 'accessor'     => \&Class::MOP::Mixin::AttributeCore::accessor     },
         predicate => { 'has_accessor' => \&Class::MOP::Mixin::AttributeCore::has_accessor },
+        _definition_context(),
     ))
 );
 
@@ -423,6 +373,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('reader' => (
         reader    => { 'reader'     => \&Class::MOP::Mixin::AttributeCore::reader     },
         predicate => { 'has_reader' => \&Class::MOP::Mixin::AttributeCore::has_reader },
+        _definition_context(),
     ))
 );
 
@@ -430,12 +381,14 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('initializer' => (
         reader    => { 'initializer'     => \&Class::MOP::Mixin::AttributeCore::initializer     },
         predicate => { 'has_initializer' => \&Class::MOP::Mixin::AttributeCore::has_initializer },
+        _definition_context(),
     ))
 );
 
 Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('definition_context' => (
         reader    => { 'definition_context'     => \&Class::MOP::Mixin::AttributeCore::definition_context     },
+        _definition_context(),
     ))
 );
 
@@ -443,6 +396,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('writer' => (
         reader    => { 'writer'     => \&Class::MOP::Mixin::AttributeCore::writer     },
         predicate => { 'has_writer' => \&Class::MOP::Mixin::AttributeCore::has_writer },
+        _definition_context(),
     ))
 );
 
@@ -450,6 +404,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('predicate' => (
         reader    => { 'predicate'     => \&Class::MOP::Mixin::AttributeCore::predicate     },
         predicate => { 'has_predicate' => \&Class::MOP::Mixin::AttributeCore::has_predicate },
+        _definition_context(),
     ))
 );
 
@@ -457,6 +412,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('clearer' => (
         reader    => { 'clearer'     => \&Class::MOP::Mixin::AttributeCore::clearer     },
         predicate => { 'has_clearer' => \&Class::MOP::Mixin::AttributeCore::has_clearer },
+        _definition_context(),
     ))
 );
 
@@ -464,6 +420,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('builder' => (
         reader    => { 'builder'     => \&Class::MOP::Mixin::AttributeCore::builder     },
         predicate => { 'has_builder' => \&Class::MOP::Mixin::AttributeCore::has_builder },
+        _definition_context(),
     ))
 );
 
@@ -471,6 +428,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('init_arg' => (
         reader    => { 'init_arg'     => \&Class::MOP::Mixin::AttributeCore::init_arg     },
         predicate => { 'has_init_arg' => \&Class::MOP::Mixin::AttributeCore::has_init_arg },
+        _definition_context(),
     ))
 );
 
@@ -478,6 +436,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
     Class::MOP::Attribute->new('default' => (
         # default has a custom 'reader' method ...
         predicate => { 'has_default' => \&Class::MOP::Mixin::AttributeCore::has_default },
+        _definition_context(),
     ))
 );
 
@@ -486,6 +445,7 @@ Class::MOP::Mixin::AttributeCore->meta->add_attribute(
         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 },
+        _definition_context(),
     ))
 );
 
@@ -501,14 +461,16 @@ Class::MOP::Attribute->meta->add_attribute(
             # we just alias the original method
             # rather than re-produce it here
             'associated_class' => \&Class::MOP::Attribute::associated_class
-        }
+        },
+        _definition_context(),
     ))
 );
 
 Class::MOP::Attribute->meta->add_attribute(
     Class::MOP::Attribute->new('associated_methods' => (
         reader   => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods },
-        default  => sub { [] }
+        default  => sub { [] },
+        _definition_context(),
     ))
 );
 
@@ -522,24 +484,28 @@ Class::MOP::Attribute->meta->add_method('clone' => sub {
 Class::MOP::Method->meta->add_attribute(
     Class::MOP::Attribute->new('body' => (
         reader   => { 'body' => \&Class::MOP::Method::body },
+        _definition_context(),
     ))
 );
 
 Class::MOP::Method->meta->add_attribute(
     Class::MOP::Attribute->new('associated_metaclass' => (
         reader   => { 'associated_metaclass' => \&Class::MOP::Method::associated_metaclass },
+        _definition_context(),
     ))
 );
 
 Class::MOP::Method->meta->add_attribute(
     Class::MOP::Attribute->new('package_name' => (
         reader   => { 'package_name' => \&Class::MOP::Method::package_name },
+        _definition_context(),
     ))
 );
 
 Class::MOP::Method->meta->add_attribute(
     Class::MOP::Attribute->new('name' => (
         reader   => { 'name' => \&Class::MOP::Method::name },
+        _definition_context(),
     ))
 );
 
@@ -547,6 +513,7 @@ Class::MOP::Method->meta->add_attribute(
     Class::MOP::Attribute->new('original_method' => (
         reader   => { 'original_method'      => \&Class::MOP::Method::original_method },
         writer   => { '_set_original_method' => \&Class::MOP::Method::_set_original_method },
+        _definition_context(),
     ))
 );
 
@@ -559,7 +526,9 @@ Class::MOP::Method->meta->add_attribute(
 # practices of attributes, but we put
 # it here for completeness
 Class::MOP::Method::Wrapped->meta->add_attribute(
-    Class::MOP::Attribute->new('modifier_table')
+    Class::MOP::Attribute->new('modifier_table' => (
+        _definition_context(),
+    ))
 );
 
 ## --------------------------------------------------------
@@ -568,13 +537,15 @@ Class::MOP::Method::Wrapped->meta->add_attribute(
 Class::MOP::Method::Generated->meta->add_attribute(
     Class::MOP::Attribute->new('is_inline' => (
         reader   => { 'is_inline' => \&Class::MOP::Method::Generated::is_inline },
-        default  => 0, 
+        default  => 0,
+        _definition_context(),
     ))
 );
 
 Class::MOP::Method::Generated->meta->add_attribute(
     Class::MOP::Attribute->new('definition_context' => (
         reader   => { 'definition_context' => \&Class::MOP::Method::Generated::definition_context },
+        _definition_context(),
     ))
 );
 
@@ -585,6 +556,7 @@ Class::MOP::Method::Generated->meta->add_attribute(
 Class::MOP::Method::Inlined->meta->add_attribute(
     Class::MOP::Attribute->new('_expected_method_class' => (
         reader   => { '_expected_method_class' => \&Class::MOP::Method::Inlined::_expected_method_class },
+        _definition_context(),
     ))
 );
 
@@ -596,12 +568,14 @@ Class::MOP::Method::Accessor->meta->add_attribute(
         reader   => {
             'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
         },
+        _definition_context(),
     ))
 );
 
 Class::MOP::Method::Accessor->meta->add_attribute(
     Class::MOP::Attribute->new('accessor_type' => (
         reader   => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
+        _definition_context(),
     ))
 );
 
@@ -613,7 +587,8 @@ Class::MOP::Method::Constructor->meta->add_attribute(
         reader   => {
             'options' => \&Class::MOP::Method::Constructor::options
         },
-        default  => sub { +{} }
+        default  => sub { +{} },
+        _definition_context(),
     ))
 );
 
@@ -623,6 +598,7 @@ Class::MOP::Method::Constructor->meta->add_attribute(
         reader   => {
             'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
         },
+        _definition_context(),
     ))
 );
 
@@ -636,6 +612,7 @@ Class::MOP::Method::Constructor->meta->add_attribute(
 Class::MOP::Instance->meta->add_attribute(
     Class::MOP::Attribute->new('associated_metaclass',
         reader   => { associated_metaclass => \&Class::MOP::Instance::associated_metaclass },
+        _definition_context(),
     ),
 );
 
@@ -645,24 +622,28 @@ Class::MOP::Instance->meta->add_attribute(
         reader   => { _class_name => \&Class::MOP::Instance::_class_name },
         #lazy     => 1, # not yet supported by Class::MOP but out our version does it anyway
         #default  => sub { $_[0]->associated_metaclass->name },
+        _definition_context(),
     ),
 );
 
 Class::MOP::Instance->meta->add_attribute(
     Class::MOP::Attribute->new('attributes',
         reader   => { attributes => \&Class::MOP::Instance::get_all_attributes },
+        _definition_context(),
     ),
 );
 
 Class::MOP::Instance->meta->add_attribute(
     Class::MOP::Attribute->new('slots',
         reader   => { slots => \&Class::MOP::Instance::slots },
+        _definition_context(),
     ),
 );
 
 Class::MOP::Instance->meta->add_attribute(
     Class::MOP::Attribute->new('slot_hash',
         reader   => { slot_hash => \&Class::MOP::Instance::slot_hash },
+        _definition_context(),
     ),
 );
 
@@ -930,59 +911,12 @@ See L<Class::MOP::Instance> for more details.
 
 Note that this module does not export any constants or functions.
 
-=head2 Constants
-
-=over 4
-
-=item I<Class::MOP::IS_RUNNING_ON_5_10>
-
-We set this constant depending on what version perl we are on, this
-allows us to take advantage of new 5.10 features and stay backwards
-compatible.
-
-=back
-
 =head2 Utility functions
 
 Note that these are all called as B<functions, not methods>.
 
 =over 4
 
-=item B<Class::MOP::load_class($class_name, \%options?)>
-
-This will load the specified C<$class_name>, if it is not already
-loaded (as reported by C<is_class_loaded>). This function can be used
-in place of tricks like C<eval "use $module"> or using C<require>
-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</Class Loading Options>.
-
-For historical reasons, this function explicitly returns a true value.
-
-=item B<Class::MOP::is_class_loaded($class_name, \%options?)>
-
-Returns a boolean indicating whether or not C<$class_name> has been
-loaded.
-
-This does a basic check of the symbol table to try and determine as
-best it can if the C<$class_name> is loaded, it is probably correct
-about 99% of the time, but it can be fooled into reporting false
-positives. In particular, loading any of the core L<IO> modules will
-cause most of the rest of the core L<IO> modules to falsely report
-having been loaded, due to the way the base L<IO> 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</Class Loading Options>.
-
 =item B<Class::MOP::get_code_info($code)>
 
 This function returns two values, the name of the package the C<$code>
@@ -996,36 +930,6 @@ This will return the metaclass of the given instance or class name.  If the
 class lacks a metaclass, no metaclass will be initialized, and C<undef> will be
 returned.
 
-=item B<Class::MOP::check_package_cache_flag($pkg)>
-
-B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
-
-This will return an integer that is managed by L<Class::MOP::Class> to
-determine if a module's symbol table has been altered.
-
-In Perl 5.10 or greater, this flag is package specific. However in
-versions prior to 5.10, this will use the C<PL_sub_generation>
-variable which is not package specific.
-
-=item B<Class::MOP::load_first_existing_class(@class_names)>
-
-=item B<Class::MOP::load_first_existing_class($classA, \%optionsA?, $classB, ...)>
-
-B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
-
-Given a list of class names, this function will attempt to load each
-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</Class Loading Options>.
-
 =back
 
 =head2 Metaclass cache functions
@@ -1084,16 +988,9 @@ 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
+Some utility functions (such as C<Class::MOP::load_class>) that were
+previously defined in C<Class::MOP> regarding loading of classes have been
+extracted to L<Class::Load>. Please see L<Class::Load> for documentation.
 
 =head1 SEE ALSO
 
@@ -1171,7 +1068,7 @@ As I have said above, this module is a class-builder-builder, so it is
 not the same thing as modules like L<Class::Accessor> and
 L<Class::MethodMaker>. That being said there are very few modules on CPAN
 with similar goals to this module. The one I have found which is most
-like this module is L<Class::Meta>, although it's philosophy and the MOP it
+like this module is L<Class::Meta>, although its philosophy and the MOP it
 creates are very different from this modules.
 
 =head1 BUGS